{ $Project$ $Workfile$ $Revision$ $DateUTC$ $Id$ This file is part of the Indy (Internet Direct) project, and is offered under the dual-licensing agreement described on the Indy website. (http://www.indyproject.org/) Copyright: (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. } { $Log$ } { Rev 1.8 4/11/2005 2:17:46 PM JPMugaas Fix from Ben Taylor for where a pointer is used after it's freed causing an invalid pointer operation. Rev 1.7 23.3.2005 ã. 20:50:04 DBondzhev Fixed problem on multi CPU systems when connection is closed while it get's connected at the end of the timeout period. Rev 1.6 11/15/2004 11:40:08 PM JPMugaas Added IPAddressType parameter to SetBinding )AIPVersion). This would set the same variable as the SetPeer AIPVersion parameter. It's just a convenience sake since both the receiver and sender must have the same type of IP address (unless there's a gateway thing we support). Rev 1.5 11/12/2004 11:30:18 AM JPMugaas Expansions for IPv6. Rev 1.4 09/06/2004 09:48:42 CCostelloe Kylix 3 patch Rev 1.3 4/26/04 12:40:26 PM RLebeau Removed recursion from Readable() Rev 1.2 2004.03.07 11:48:48 AM czhower Flushbuffer fix + other minor ones found Rev 1.1 3/6/2004 5:16:14 PM JPMugaas Bug 67 fixes. Do not write to const values. Rev 1.0 2004.02.03 3:14:40 PM czhower Move and updates Rev 1.23 2/2/2004 12:09:16 AM JPMugaas GetSockOpt should now work in DotNET. Rev 1.22 2/1/2004 6:10:46 PM JPMugaas GetSockOpt. Rev 1.21 12/31/2003 9:51:58 PM BGooijen Added IPv6 support Rev 1.20 10/26/2003 12:29:40 PM BGooijen DotNet Rev 1.19 10/22/2003 04:40:48 PM JPMugaas Should compile with some restored functionality. Still not finished. Rev 1.18 2003.10.11 5:50:26 PM czhower -VCL fixes for servers -Chain suport for servers (Super core) -Scheduler upgrades -Full yarn support Rev 1.17 10/5/2003 9:55:30 PM BGooijen TIdTCPServer works on D7 and DotNet now Rev 1.16 2003.10.02 12:44:42 PM czhower Fix for Bind, Connect Rev 1.15 2003.10.02 10:16:28 AM czhower .Net Rev 1.14 2003.10.01 9:11:20 PM czhower .Net Rev 1.13 2003.10.01 5:05:14 PM czhower .Net Rev 1.12 2003.10.01 2:30:40 PM czhower .Net Rev 1.10 10/1/2003 12:14:12 AM BGooijen DotNet: removing CheckForSocketError Rev 1.9 2003.10.01 1:12:36 AM czhower .Net Rev 1.8 2003.09.30 1:23:02 PM czhower Stack split for DotNet Rev 1.7 20.09.2003 16:33:28 ARybin bug fix: NOT Integer <> 0 is not boolean operation, because: (NOT Integer) = inverted integer Rev 1.6 2003.07.14 1:57:24 PM czhower -First set of IOCP fixes. -Fixed a threadsafe problem with the stack class. Rev 1.5 7/1/2003 05:20:36 PM JPMugaas Minor optimizations. Illiminated some unnecessary string operations. Rev 1.4 7/1/2003 03:39:52 PM JPMugaas Started numeric IP function API calls for more efficiency. Rev 1.3 5/11/2003 11:59:06 AM BGooijen Added OverLapped property Rev 1.2 5/11/2003 12:35:30 AM BGooijen temporary creates overlapped socked handles Rev 1.1 3/21/2003 01:50:08 AM JPMugaas SetBinding method added as per request received in private E-Mail. Rev 1.0 11/13/2002 08:58:46 AM JPMugaas } unit IdSocketHandle; interface {$I IdCompilerDefines.inc} uses Classes, IdException, IdGlobal, IdStackConsts, IdStack, IdBaseComponent; type TIdSocketHandle = class; TIdSocketHandles = class(TOwnedCollection) protected FDefaultPort: TIdPort; // function GetItem(Index: Integer): TIdSocketHandle; procedure SetItem(Index: Integer; const Value: TIdSocketHandle); public constructor Create(AOwner: TComponent); reintroduce; function Add: TIdSocketHandle; reintroduce; function BindingByHandle(const AHandle: TIdStackSocketHandle): TIdSocketHandle; property Items[Index: Integer]: TIdSocketHandle read GetItem write SetItem; default; // property DefaultPort: TIdPort read FDefaultPort write FDefaultPort; end; TIdSocketHandle = class(TCollectionItem) protected FClientPortMin: TIdPort; FClientPortMax: TIdPort; FHandle: TIdStackSocketHandle; FHandleAllocated: Boolean; FIP: string; FPeerIP: string; FPort: TIdPort; FPeerPort: TIdPort; FReadSocketList: TIdSocketList; FSocketType : TIdSocketType; FOverLapped: Boolean; FIPVersion: TIdIPVersion; FConnectionHandle: TIdCriticalSection; FBroadcastEnabled: Boolean; FUseNagle : Boolean; FReuseSocket: TIdReuseSocket; // function BindPortReserved: Boolean; procedure BroadcastEnabledChanged; procedure SetBroadcastEnabled(const AValue: Boolean); procedure Disconnect; virtual; procedure SetBroadcastFlag(const AEnabled: Boolean); procedure SetOverLapped(const AValue: Boolean); procedure SetHandle(AHandle: TIdStackSocketHandle); procedure SetIPVersion(const Value: TIdIPVersion); procedure SetUseNagle(const AValue: Boolean); function TryBind(APort: TIdPort): Boolean; public function Accept(ASocket: TIdStackSocketHandle): Boolean; procedure AllocateSocket(const ASocketType: TIdSocketType = Id_SOCK_STREAM; const AProtocol: TIdSocketProtocol = Id_IPPROTO_IP); // Returns True if error was ignored (Matches iIgnore), false if no error occurred procedure Assign(Source: TPersistent); override; procedure Bind; procedure Broadcast(const AData: string; const APort: TIdPort; const AIP: String = ''; AByteEncoding: IIdTextEncoding = nil {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF} ); overload; procedure Broadcast(const AData: TIdBytes; const APort: TIdPort; const AIP: String = ''); overload; procedure CloseSocket; virtual; procedure Connect; virtual; constructor Create(ACollection: TCollection); override; destructor Destroy; override; procedure Listen(const AQueueCount: Integer = 5); function Readable(AMSec: Integer = IdTimeoutDefault): boolean; function Receive(var VBuffer: TIdBytes): Integer; function RecvFrom(var ABuffer : TIdBytes; var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion): Integer; procedure Reset(const AResetLocal: boolean = True); function Send(const AData: String; AByteEncoding: IIdTextEncoding = nil {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF} ): Integer; overload; function Send(const ABuffer: TIdBytes; const AOffset: Integer = 0; const ASize: Integer = -1): Integer; overload; procedure SendTo(const AIP: string; const APort: TIdPort; const AData: String; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION; AByteEncoding: IIdTextEncoding = nil {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF} ); overload; procedure SendTo(const AIP: string; const APort: TIdPort; const ABuffer : TIdBytes; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); overload; procedure SendTo(const AIP: string; const APort: TIdPort; const ABuffer : TIdBytes; const AOffset: Integer; const ASize: Integer; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); overload; procedure SetPeer(const AIP: string; const APort: TIdPort; const AIPVersion : TIdIPVersion = ID_DEFAULT_IP_VERSION); procedure SetBinding(const AIP: string; const APort: TIdPort; const AIPVersion : TIdIPVersion = ID_DEFAULT_IP_VERSION); procedure GetSockOpt(ALevel: TIdSocketOptionLevel; AOptName: TIdSocketOption; out VOptVal: Integer); procedure SetSockOpt(ALevel: TIdSocketOptionLevel; AOptName: TIdSocketOption; AOptVal: Integer); function Select(ATimeout: Integer = IdTimeoutInfinite): Boolean; procedure UpdateBindingLocal; procedure UpdateBindingPeer; procedure AddMulticastMembership(const AGroupIP: String); procedure DropMulticastMembership(const AGroupIP: String); procedure SetKeepAliveValues(const AEnabled: Boolean; const ATimeMS, AInterval: Integer); procedure SetLoopBack(const AValue: Boolean); procedure SetMulticastTTL(const AValue: Byte); procedure SetTTL(const AValue: Integer); procedure SetNagleOpt(const AEnabled: Boolean); // property HandleAllocated: Boolean read FHandleAllocated; property Handle: TIdStackSocketHandle read FHandle; property OverLapped: Boolean read FOverLapped write SetOverLapped; property PeerIP: string read FPeerIP; property PeerPort: TIdPort read FPeerPort; property SocketType : TIdSocketType read FSocketType; published property BroadcastEnabled: Boolean read FBroadcastEnabled write SetBroadcastEnabled default False; property ClientPortMin : TIdPort read FClientPortMin write FClientPortMin default DEF_PORT_ANY; property ClientPortMax : TIdPort read FClientPortMax write FClientPortMax default DEF_PORT_ANY; property IP: string read FIP write FIP; property IPVersion: TIdIPVersion read FIPVersion write SetIPVersion default ID_DEFAULT_IP_VERSION; property Port: TIdPort read FPort write FPort; property ReuseSocket: TIdReuseSocket read FReuseSocket write FReuseSocket default rsOSDependent; property UseNagle: Boolean read FUseNagle write SetUseNagle default True; end; TIdSocketHandleEvent = procedure(AHandle: TIdSocketHandle) of object; implementation uses {$IFDEF VCL_XE3_OR_ABOVE} System.SyncObjs, {$ENDIF} IdAntiFreezeBase, IdComponent, IdResourceStrings, SysUtils; { TIdSocketHandle } procedure TIdSocketHandle.AllocateSocket(const ASocketType: TIdSocketType; const AProtocol: TIdSocketProtocol); begin // If we are reallocating a socket - close and destroy the old socket handle CloseSocket; if HandleAllocated then begin Reset; end; // Set property so it calls the writer SetHandle(GStack.NewSocketHandle(ASocketType, AProtocol, FIPVersion, FOverLapped)); end; procedure TIdSocketHandle.Disconnect; begin GStack.Disconnect(Handle); end; procedure TIdSocketHandle.CloseSocket; begin if HandleAllocated then begin FConnectionHandle.Enter; try // Must be first, closing socket will trigger some errors, and they // may then call (in other threads) Connected, which in turn looks at // FHandleAllocated. FHandleAllocated := False; Disconnect; SetHandle(Id_INVALID_SOCKET); finally FConnectionHandle.Leave; end; end; end; procedure TIdSocketHandle.Connect; begin GStack.Connect(Handle, PeerIP, PeerPort, FIPVersion); FConnectionHandle.Enter; try if HandleAllocated then begin // UpdateBindingLocal needs to be called even though Bind calls it. After // Bind is may be 0.0.0.0 (INADDR_ANY). After connect it will be a real IP. UpdateBindingLocal; //TODO: Could Peer binding ever be other than what we specified above? // Need to reread it? UpdateBindingPeer; end; finally FConnectionHandle.Leave; end; end; destructor TIdSocketHandle.Destroy; begin CloseSocket; FreeAndNil(FConnectionHandle); FreeAndNil(FReadSocketList); inherited Destroy; end; function TIdSocketHandle.Receive(var VBuffer: TIdBytes): Integer; begin Result := GStack.Receive(Handle, VBuffer); end; function TIdSocketHandle.Send(const AData: String; AByteEncoding: IIdTextEncoding = nil {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF} ): Integer; begin Result := Send(ToBytes(AData, AByteEncoding{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF})); end; function TIdSocketHandle.Send(const ABuffer: TIdBytes; const AOffset: Integer = 0; const ASize: Integer = -1): Integer; begin Result := GStack.Send(Handle, ABuffer, AOffset, ASize); end; procedure TIdSocketHandle.SetSockOpt(ALevel: TIdSocketOptionLevel; AOptName: TIdSocketOption; AOptVal: Integer); begin GStack.SetSocketOption(Handle, ALevel, AOptName, AOptVal); end; procedure TIdSocketHandle.SendTo(const AIP: string; const APort: TIdPort; const AData: String; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION; AByteEncoding: IIdTextEncoding = nil {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF} ); begin SendTo(AIP, APort, ToBytes(AData, AByteEncoding{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}), AIPVersion); end; procedure TIdSocketHandle.SendTo(const AIP: string; const APort: TIdPort; const ABuffer : TIdBytes; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); begin SendTo(AIP, APort, ABuffer, 0, -1, AIPVersion); end; procedure TIdSocketHandle.SendTo(const AIP: string; const APort: TIdPort; const ABuffer : TIdBytes; const AOffset: Integer; const ASize: Integer; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); begin GStack.SendTo(Handle, ABuffer, AOffset, ASize, AIP, APort, AIPVersion); end; function TIdSocketHandle.RecvFrom(var ABuffer : TIdBytes; var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion): Integer; begin Result := GStack.ReceiveFrom(Handle, ABuffer, VIP, VPort, VIPVersion); end; procedure TIdSocketHandle.Bind; begin SetSockOpt(Id_SOL_SOCKET, Id_SO_REUSEADDR, iif( (FReuseSocket = rsTrue) or ((FReuseSocket = rsOSDependent) and (GOSType = otUnix)), Id_SO_True, Id_SO_False ) ); if (Port = 0) and (FClientPortMin <> 0) and (FClientPortMax <> 0) then begin if (FClientPortMin > FClientPortMax) then begin raise EIdInvalidPortRange.CreateFmt(RSInvalidPortRange, [FClientPortMin, FClientPortMax]); end else if not BindPortReserved then begin raise EIdCanNotBindPortInRange.CreateFmt(RSCannotBindRange, [FClientPortMin, FClientPortMax]); end; end else if not TryBind(Port) then begin raise EIdCouldNotBindSocket.Create(RSCouldNotBindSocket); end; end; procedure TIdSocketHandle.Broadcast(const AData: string; const APort: TIdPort; const AIP: String = ''; AByteEncoding: IIdTextEncoding = nil {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF} ); begin Broadcast(ToBytes(AData, AByteEncoding{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}), APort, AIP); end; procedure TIdSocketHandle.Broadcast(const AData: TIdBytes; const APort: TIdPort; const AIP: String = ''); var LIP: String; begin LIP := Trim(AIP); if LIP = '' then begin // TODO: on Windows, use WSAIoctl(SIO_GET_BROADCAST_ADDRESS) instead. // On other platforms, use getifaddrs() or other suitable API to retreive // the broadcast IP if possible, or else the local IP/Subnet and then // calculate the broadcast IP manually... LIP := '255.255.255.255'; {Do not Localize} end else begin LIP := GStack.ResolveHost(LIP, IPVersion); end; SetBroadcastFlag(True); SendTo(LIP, APort, AData); BroadcastEnabledChanged; end; procedure TIdSocketHandle.BroadcastEnabledChanged; begin SetBroadcastFlag(FBroadcastEnabled); end; procedure TIdSocketHandle.SetPeer(const AIP: string; const APort: TIdPort; const AIPVersion : TIdIPVersion = ID_DEFAULT_IP_VERSION); begin FPeerIP := AIP; FPeerPort := APort; FIPVersion := AIPVersion; end; procedure TIdSocketHandle.SetBinding(const AIP: string; const APort: TIdPort; const AIPVersion : TIdIPVersion = ID_DEFAULT_IP_VERSION); begin FIP := AIP; FPort := APort; FIPVersion := AIPVersion; end; procedure TIdSocketHandle.SetBroadcastEnabled(const AValue: Boolean); begin if FBroadCastEnabled <> AValue then begin FBroadcastEnabled := AValue; if HandleAllocated then begin BroadcastEnabledChanged; end; end; end; procedure TIdSocketHandle.SetBroadcastFlag(const AEnabled: Boolean); begin GStack.SetSocketOption(Handle, Id_SOL_SOCKET, Id_SO_BROADCAST, iif(AEnabled, 1, 0)); end; procedure TIdSocketHandle.SetOverLapped(const AValue:boolean); begin // TODO: check for HandleAllocated FOverLapped := AValue; end; procedure TIdSocketHandle.Listen(const AQueueCount: Integer = 5); begin GStack.Listen(Handle, AQueueCount); end; function TIdSocketHandle.Accept(ASocket: TIdStackSocketHandle): Boolean; var LAcceptedSocket: TIdStackSocketHandle; LIP: String; LPort: TIdPort; begin Reset; LAcceptedSocket := GStack.Accept(ASocket, LIP, LPort); Result := (LAcceptedSocket <> Id_INVALID_SOCKET); if Result then begin SetHandle(LAcceptedSocket); // UpdateBindingLocal is necessary as it may be listening on multiple IPs/Ports UpdateBindingLocal; UpdateBindingPeer; end; end; constructor TIdSocketHandle.Create(ACollection: TCollection); begin inherited Create(ACollection); FUseNagle := True; FReuseSocket := rsOSDependent; FConnectionHandle := TIdCriticalSection.Create; FReadSocketList := TIdSocketList.CreateSocketList; Reset; FClientPortMin := 0; FClientPortMax := 0; FIPVersion := ID_DEFAULT_IP_VERSION; if Assigned(ACollection) then begin Port := TIdSocketHandles(ACollection).DefaultPort; end; end; function TIdSocketHandle.Readable(AMSec: Integer = IdTimeoutDefault): Boolean; function CheckIsReadable(ALMSec: Integer): Boolean; begin if not HandleAllocated then begin raise EIdConnClosedGracefully.Create(RSConnectionClosedGracefully); end; Result := Select(ALMSec); end; begin if AMSec = IdTimeoutDefault then begin AMSec := IdTimeoutInfinite; end; if TIdAntiFreezeBase.ShouldUse then begin if AMSec = IdTimeoutInfinite then begin repeat Result := CheckIsReadable(GAntiFreeze.IdleTimeOut); until Result; Exit; end; while AMSec > GAntiFreeze.IdleTimeOut do begin Result := CheckIsReadable(GAntiFreeze.IdleTimeOut); if Result then begin Exit; end; Dec(AMSec, GAntiFreeze.IdleTimeOut); end; end; Result := CheckIsReadable(AMSec); end; procedure TIdSocketHandle.Assign(Source: TPersistent); var LSource: TIdSocketHandle; begin if Source is TIdSocketHandle then begin LSource := TIdSocketHandle(Source); FIP := LSource.FIP; Port := LSource.Port; FPeerIP := LSource.FPeerIP; FPeerPort := LSource.FPeerPort; FIPVersion := LSource.IPVersion; end else begin inherited end; end; procedure TIdSocketHandle.UpdateBindingLocal; begin GStack.GetSocketName(Handle, FIP, FPort, FIPVersion); end; procedure TIdSocketHandle.UpdateBindingPeer; begin GStack.GetPeerName(Handle, FPeerIP, FPeerPort, FIPVersion); end; procedure TIdSocketHandle.Reset(const AResetLocal: boolean = True); begin SetHandle(Id_INVALID_SOCKET); if AResetLocal then begin FIP := ''; FPort := 0; end; FPeerIP := ''; FPeerPort := 0; FIPVersion := ID_DEFAULT_IP_VERSION; end; function TIdSocketHandle.TryBind(APort: TIdPort): Boolean; begin try GStack.Bind(Handle, FIP, APort, FIPVersion); Result := True; UpdateBindingLocal; except Result := False; end; end; function TIdSocketHandle.BindPortReserved: Boolean; var i : TIdPort; begin Result := False; for i := FClientPortMax downto FClientPortMin do begin if TryBind(i) then begin Result := True; Exit; end; end; end; procedure TIdSocketHandle.GetSockOpt(ALevel: TIdSocketOptionLevel; AOptName: TIdSocketOption; out VOptVal: Integer); begin GStack.GetSocketOption(Handle, ALevel, AOptName, VOptVal); end; function TIdSocketHandle.Select(ATimeOut: Integer = IdTimeoutInfinite): Boolean; begin Result := FReadSocketList.SelectRead(ATimeOut); TIdAntiFreezeBase.DoProcess(Result = False); end; procedure TIdSocketHandle.SetHandle(AHandle: TIdStackSocketHandle); var LOpt: Integer; begin if FHandle <> Id_INVALID_SOCKET then begin FReadSocketList.Remove(FHandle); end; FHandle := AHandle; FHandleAllocated := FHandle <> Id_INVALID_SOCKET; if FHandleAllocated then begin FReadSocketList.Add(FHandle); GetSockOpt(Id_SOL_SOCKET, Id_SO_TYPE, FSocketType); //Get the NODELAY Socket option if we have a TCP Socket. if SocketType = Id_SOCK_STREAM then begin GetSockOpt(Id_SOCKETOPTIONLEVEL_TCP, Id_TCP_NODELAY, LOpt); FUseNagle := (LOpt = 0); end; end else begin FSocketType := Id_SOCK_UNKNOWN; end; end; procedure TIdSocketHandle.SetIPVersion(const Value: TIdIPVersion); begin if Value <> FIPVersion then begin if HandleAllocated then begin raise EIdCannotSetIPVersionWhenConnected.Create(RSCannotSetIPVersionWhenConnected); end; FIPVersion := Value; end; end; procedure TIdSocketHandle.AddMulticastMembership(const AGroupIP: String); begin GStack.AddMulticastMembership(Handle, AGroupIP, FIP, FIPVersion); end; procedure TIdSocketHandle.DropMulticastMembership(const AGroupIP: String); begin GStack.DropMulticastMembership(Handle, AGroupIP, FIP, FIPVersion); end; procedure TIdSocketHandle.SetKeepAliveValues(const AEnabled: Boolean; const ATimeMS, AInterval: Integer); begin GStack.SetKeepAliveValues(Handle, AEnabled, ATimeMS, AInterval); end; procedure TIdSocketHandle.SetLoopBack(const AValue: Boolean); begin GStack.SetLoopBack(Handle, AValue, FIPVersion); end; procedure TIdSocketHandle.SetMulticastTTL(const AValue: Byte); begin GStack.SetMulticastTTL(Handle, AValue, FIPVersion); end; procedure TIdSocketHandle.SetNagleOpt(const AEnabled: Boolean); begin { You only want to set a Nagle option for TCP.} if HandleAllocated and (SocketType = Id_SOCK_STREAM) then begin SetSockOpt(Id_SOCKETOPTIONLEVEL_TCP, Id_TCP_NODELAY, Integer(not AEnabled)); end; end; procedure TIdSocketHandle.SetTTL(const AValue: Integer); begin if FIPVersion = Id_IPv4 then begin SetSockOpt(Id_SOL_IP, Id_SO_IP_TTL, AValue); end else begin SetSockOpt(Id_SOL_IPv6, Id_IPV6_UNICAST_HOPS, AValue); end; end; procedure TIdSocketHandle.SetUseNagle(const AValue: Boolean); begin if FUseNagle <> AValue then begin FUseNagle := AValue; SetNagleOpt(FUseNagle); end; end; { TIdSocketHandles } function TIdSocketHandles.Add: TIdSocketHandle; begin Result := inherited Add as TIdSocketHandle; Result.Port := DefaultPort; end; function TIdSocketHandles.BindingByHandle(const AHandle: TIdStackSocketHandle): TIdSocketHandle; var i: integer; begin Result := nil; for i := Count-1 downto 0 do begin if Items[i].Handle = AHandle then begin Result := Items[i]; Exit; end; end; end; constructor TIdSocketHandles.Create(AOwner: TComponent); begin inherited Create(AOwner, TIdSocketHandle); end; function TIdSocketHandles.GetItem(Index: Integer): TIdSocketHandle; begin Result := TIdSocketHandle(inherited Items[index]); end; procedure TIdSocketHandles.SetItem(Index: Integer; const Value: TIdSocketHandle); begin inherited SetItem(Index, Value); end; end.