www.pudn.com > indy10.0.52_source.rar > IdIOHandlerSocket.pas
{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence }
{ Team Coherence is Copyright 2002 by Quality Software Components }
{ }
{ For further information / comments, visit our WEB site at }
{ http://www.TeamCoherence.com }
{**********************************************************************}
{}
{ $Log: 11950: IdIOHandlerSocket.pas
{
{ Rev 1.38 11/10/2004 8:25:54 AM JPMugaas
{ Fix for AV caused by short-circut boolean evaluation.
}
{
{ Rev 1.37 27.08.2004 21:58:20 Andreas Hausladen
{ Speed optimization ("const" for string parameters)
}
{
{ Rev 1.36 8/2/04 5:44:40 PM RLebeau
{ Moved ConnectTimeout over from TIdIOHandlerStack
}
{
{ Rev 1.35 7/21/2004 12:22:32 PM BGooijen
{ Fix to .connected
}
{
{ Rev 1.34 6/30/2004 12:31:34 PM BGooijen
{ Added OnSocketAllocated
}
{
{ Rev 1.33 4/24/04 12:52:52 PM RLebeau
{ Added setter method to UseNagle property
}
{
{ Rev 1.32 2004.04.18 12:52:02 AM czhower
{ Big bug fix with server disconnect and several other bug fixed that I found
{ along the way.
}
{
{ Rev 1.31 2004.02.03 4:16:46 PM czhower
{ For unit name changes.
}
{
{ Rev 1.30 2/2/2004 11:46:46 AM BGooijen
{ Dotnet and TransparentProxy
}
{
{ Rev 1.29 2/1/2004 9:44:00 PM JPMugaas
{ Start on reenabling Transparant proxy.
}
{
{ Rev 1.28 2004.01.20 10:03:28 PM czhower
{ InitComponent
}
{
{ Rev 1.27 1/2/2004 12:02:16 AM BGooijen
{ added OnBeforeBind/OnAfterBind
}
{
{ Rev 1.26 12/31/2003 9:51:56 PM BGooijen
{ Added IPv6 support
}
{
{ Rev 1.25 11/4/2003 10:37:40 PM BGooijen
{ JP's patch to fix the bound port
}
{
{ Rev 1.24 10/19/2003 5:21:26 PM BGooijen
{ SetSocketOption
}
{
{ Rev 1.23 10/18/2003 1:44:06 PM BGooijen
{ Added include
}
{
{ Rev 1.22 2003.10.14 1:26:54 PM czhower
{ Uupdates + Intercept support
}
{
{ Rev 1.21 10/9/2003 8:09:06 PM SPerry
{ bug fixes
}
{
{ Rev 1.20 8/10/2003 2:05:50 PM SGrobety
{ Dotnet
}
{
{ Rev 1.19 2003.10.07 10:18:26 PM czhower
{ Uncommneted todo code that is now non dotnet.
}
{
{ Rev 1.18 2003.10.02 8:23:42 PM czhower
{ DotNet Excludes
}
{
{ Rev 1.17 2003.10.01 9:11:18 PM czhower
{ .Net
}
{
{ Rev 1.16 2003.10.01 5:05:12 PM czhower
{ .Net
}
{
{ Rev 1.15 2003.10.01 2:46:38 PM czhower
{ .Net
}
{
{ Rev 1.14 2003.10.01 11:16:32 AM czhower
{ .Net
}
{
{ Rev 1.13 2003.09.30 1:22:58 PM czhower
{ Stack split for DotNet
}
{
{ Rev 1.12 7/4/2003 08:26:44 AM JPMugaas
{ Optimizations.
}
{
{ Rev 1.11 7/1/2003 03:39:44 PM JPMugaas
{ Started numeric IP function API calls for more efficiency.
}
{
{ Rev 1.10 2003.06.30 5:41:56 PM czhower
{ -Fixed AV that occurred sometimes when sockets were closed with chains
{ -Consolidated code that was marked by a todo for merging as it no longer
{ needed to be separate
{ -Removed some older code that was no longer necessary
{
{ Passes bubble tests.
}
{
Rev 1.9 6/3/2003 11:45:58 PM BGooijen
Added .Connected
}
{
{ Rev 1.8 2003.04.22 7:45:34 PM czhower
}
{
Rev 1.7 4/2/2003 3:24:56 PM BGooijen
Moved transparantproxy from ..stack to ..socket
}
{
Rev 1.6 2/28/2003 9:51:56 PM BGooijen
removed the field: FReadTimeout: Integer, it hided the one in TIdIOHandler
}
{
Rev 1.5 2/26/2003 1:15:38 PM BGooijen
FBinding is now freed in IdIOHandlerSocket, instead of in IdIOHandlerStack
}
{
{ Rev 1.4 2003.02.25 1:36:08 AM czhower
}
{
{ Rev 1.3 2002.12.07 12:26:26 AM czhower
}
{
{ Rev 1.2 12-6-2002 20:09:14 BGooijen
{ Changed SetDestination to search for the last ':', instead of the first
}
{
{ Rev 1.1 12-6-2002 18:54:14 BGooijen
{ Added IPv6-support
}
{
{ Rev 1.0 11/13/2002 08:45:08 AM JPMugaas
}
unit IdIOHandlerSocket;
interface
{$I IdCompilerDefines.inc}
uses
IdCustomTransparentProxy,
Classes,
IdGlobal, IdIOHandler, IdSocketHandle;
const
IdDefTimeout = 0;
IdBoundPortDefault = 0;
type
{
TIdIOHandlerSocket is the base class for socket IOHandlers that implement a
binding.
Descendants
-TIdIOHandlerStack
-TIdIOHandlerChain
}
TIdIOHandlerSocket = class(TIdIOHandler)
protected
FBinding: TIdSocketHandle;
FBoundIP: string;
FBoundPort: Integer;
FBoundPortMax: Integer;
FBoundPortMin: Integer;
FDefaultPort: Integer;
FOnBeforeBind: TNotifyEvent;
FOnAfterBind: TNotifyEvent;
FOnSocketAllocated: TNotifyEvent;
FTransparentProxy: TIdCustomTransparentProxy;
FUseNagle: Boolean;
FIPVersion: TIdIPVersion;
//
procedure ConnectClient; virtual;
procedure DoBeforeBind; virtual;
procedure DoAfterBind; virtual;
procedure DoSocketAllocated; virtual;
procedure InitComponent; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
function GetDestination: string; override;
procedure SetDestination(const AValue: string); override;
function GetTransparentProxy: TIdCustomTransparentProxy; virtual;
procedure SetTransparentProxy(AProxy: TIdCustomTransparentProxy); virtual;
procedure SetUseNagle(AValue: Boolean);
procedure SetNagleOpt(AEnabled: Boolean);
public
destructor Destroy; override;
function BindingAllocated: Boolean;
procedure Close; override;
function Connected: Boolean; override;
procedure Open; override;
function WriteFile(
const AFile: String;
AEnableTransferFile: Boolean = False
): Cardinal;
override;
//
property Binding: TIdSocketHandle read FBinding;
property BoundPortMax: Integer read FBoundPortMax write FBoundPortMax;
property BoundPortMin: Integer read FBoundPortMin write FBoundPortMin;
// events
property OnBeforeBind:TNotifyEvent read FOnBeforeBind write FOnBeforeBind;
property OnAfterBind:TNotifyEvent read FOnAfterBind write FOnAfterBind;
property OnSocketAllocated:TNotifyEvent read FOnSocketAllocated write FOnSocketAllocated;
published
property BoundIP: string read FBoundIP write FBoundIP;
property BoundPort: Integer read FBoundPort write FBoundPort default 0;
property DefaultPort: integer read FDefaultPort write FDefaultPort;
property IPVersion: TIdIPVersion read FIPVersion write FIPVersion default ID_DEFAULT_IP_VERSION;
property TransparentProxy: TIdCustomTransparentProxy
read GetTransparentProxy write SetTransparentProxy;
property UseNagle: boolean read FUseNagle write SetUseNagle default True;
end;
implementation
uses
IdStack,
IdStackConsts,
IdSocks,
SysUtils;
{ TIdIOHandlerSocket }
procedure TIdIOHandlerSocket.Close;
begin
if FBinding <> nil then begin
FBinding.CloseSocket;
end;
inherited;
end;
procedure TIdIOHandlerSocket.ConnectClient;
begin
with Binding do begin
DoBeforeBind;
// Allocate the socket
IPVersion := Self.FIPVersion;
AllocateSocket;
DoSocketAllocated;
// Bind the socket
if BoundIP <> '' then begin
IP := BoundIP;
end;
Port := BoundPort;
ClientPortMin := BoundPortMin;
ClientPortMax := BoundPortMax;
Bind;
// Turn off Nagle if specified
SetNagleOpt(UseNagle);
DoAfterBind;
end;
end;
function TIdIOHandlerSocket.Connected: Boolean;
begin
Result := (BindingAllocated and inherited Connected) or not InputBufferIsEmpty;
end;
destructor TIdIOHandlerSocket.Destroy;
begin
if Assigned(FTransparentProxy) then begin
if FTransparentProxy.Owner = nil then begin
FreeAndNil(FTransparentProxy);
end;
end;
FreeAndNil(FBinding);
inherited Destroy;
end;
procedure TIdIOHandlerSocket.DoBeforeBind;
begin
if Assigned(FOnBeforeBind) then begin
FOnBeforeBind(self);
end;
end;
procedure TIdIOHandlerSocket.DoAfterBind;
begin
if Assigned(FOnAfterBind) then begin
FOnAfterBind(self);
end;
end;
procedure TIdIOHandlerSocket.DoSocketAllocated;
begin
if Assigned(FOnSocketAllocated) then begin
FOnSocketAllocated(self);
end;
end;
function TIdIOHandlerSocket.GetDestination: string;
begin
Result := Host;
if (Port <> DefaultPort) and (Port > 0) then begin
Result := Host + ':' + IntToStr(Port);
end;
end;
procedure TIdIOHandlerSocket.Open;
begin
inherited;
if not Assigned(FBinding) then begin
FBinding := TIdSocketHandle.Create(nil);
end else begin
FBinding.Reset(True);
end;
FBinding.ClientPortMin := BoundPortMin;
FBinding.ClientPortMax := BoundPortMax;
if (Host <> '') and (Port > 0) then begin
ConnectClient;
end;
end;
procedure TIdIOHandlerSocket.SetDestination(const AValue: string);
var LPortStart:integer;
begin
// Bas Gooijen 06-Dec-2002: Changed to search the last ':', instead of the first:
LPortStart := LastDelimiter(':', AValue);
if LPortStart > 0 then begin
Host := Copy(AValue,1,LPortStart-1);
Port := StrToIntDef(Trim(Copy(AValue, LPortStart + 1, $FF)), DefaultPort);
end;
end;
function TIdIOHandlerSocket.BindingAllocated: Boolean;
begin
Result := FBinding <> nil;
if Result then begin
Result := FBinding.HandleAllocated;
end;
end;
function TIdIOHandlerSocket.WriteFile(const AFile: String;
AEnableTransferFile: Boolean): Cardinal;
var
LProcessed: Boolean;
begin
Result := 0;
LProcessed := False;
// if FileExists(AFile) then begin
//TODO: Reenable this
// if Assigned(GServeFileProc) and (WriteBufferingActive = False)
// {and (Intercept = nil)} and AEnableTransferFile
// then begin
// Result := GServeFileProc(Binding.Handle, AFile);
// LProcessed := True;
// end;
// end;
if not LProcessed then begin
Result := inherited WriteFile(AFile, AEnableTransferFile);
end;
end;
procedure TIdIOHandlerSocket.SetTransparentProxy(AProxy : TIdCustomTransparentProxy);
var
LClass: TIdCustomTransparentProxyClass;
begin
// All this is to preserve the compatibility with old version
// In the case when we have SocksInfo as object created in runtime without owner form it is treated as temporary object
// In the case when the ASocks points to an object with owner it is treated as component on form.
if Assigned(AProxy) then begin
if NOT Assigned(AProxy.Owner) then begin
if Assigned(FTransparentProxy) then begin
if Assigned(FTransparentProxy.Owner) then begin
FTransparentProxy := nil;
end;
end;
LClass := TIdCustomTransparentProxyClass(AProxy.ClassType);
// SG: was:
// LClass := Pointer(AProxy.ClassType);
if Assigned(FTransparentProxy) then begin
if FTransparentProxy.ClassType <> LClass then begin
FreeAndNIL(FTransparentProxy);
FTransparentProxy := LClass.Create(NIL);
end;
end else begin
FTransparentProxy := LClass.Create(NIL);
end;
FTransparentProxy.Assign(AProxy);
end else begin
if Assigned(FTransparentProxy) and NOT Assigned(FTransparentProxy.Owner) then begin
FreeAndNIL(FTransparentProxy);//tmp obj
end;
FTransparentProxy := AProxy;
FTransparentProxy.FreeNotification(SELF);
end;
end
else begin
if Assigned(FTransparentProxy) and NOT Assigned(FTransparentProxy.Owner) then begin
FreeAndNIL(FTransparentProxy);//tmp obj
end else begin
FTransparentProxy := NIL; //remove link
end;
end;
end;
function TIdIOHandlerSocket.GetTransparentProxy: TIdCustomTransparentProxy;
begin
// Necessary at design time for Borland SOAP support
if FTransparentProxy = nil then begin
FTransparentProxy := TIdSocksInfo.Create(nil); //default
end;
Result := FTransparentProxy;
end;
procedure TIdIOHandlerSocket.SetUseNagle(AValue: Boolean);
begin
if FUseNagle <> AValue then begin
FUseNagle := AValue;
SetNagleOpt(FUseNagle);
end;
end;
procedure TIdIOHandlerSocket.SetNagleOpt(AEnabled: Boolean);
begin
if BindingAllocated then begin
GStack.SetSocketOption(FBinding.Handle, Id_SOCKETOPTIONLEVEL_TCP, Id_TCP_NODELAY, Integer(not AEnabled));
end;
end;
procedure TIdIOHandlerSocket.Notification(AComponent: TComponent; Operation: TOperation);
begin
if (Operation = opRemove) and (AComponent = FTransparentProxy) then begin
FTransparentProxy := nil;
end;
inherited Notification(AComponent, Operation);
end;
procedure TIdIOHandlerSocket.InitComponent;
begin
inherited;
FUseNagle := True;
FIPVersion := ID_DEFAULT_IP_VERSION;
end;
end.