home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 2000 March / pcp161b.iso / full / delphi / RUNIMAGE / DELPHI30 / SOURCE / INTERNET / SCKTCOMP.PAS
Encoding:
Pascal/Delphi Source File  |  1997-08-03  |  55.3 KB  |  1,932 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {       Windows socket components                       }
  6. {                                                       }
  7. {       Copyright (c) 1997 Borland International        }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit ScktComp;
  12.  
  13. interface
  14.  
  15. uses SysUtils, Windows, Messages, Classes, WinSock, SyncObjs;
  16.  
  17. const
  18.   CM_SOCKETMESSAGE = WM_USER + $0001;
  19.   CM_DEFERFREE = WM_USER + $0002;
  20.  
  21. type
  22.   ESocketError = class(Exception);
  23.  
  24.   TCMSocketMessage = record
  25.     Msg: Cardinal;
  26.     Socket: TSocket;
  27.     SelectEvent: Word;
  28.     SelectError: Word;
  29.     Result: Longint;
  30.   end;
  31.  
  32.   TCustomWinSocket = class;
  33.   TCustomSocket = class;
  34.   TServerAcceptThread = class;
  35.   TServerClientThread = class;
  36.   TServerWinSocket = class;
  37.   TServerClientWinSocket = class;
  38.  
  39.   TServerType = (stNonBlocking, stThreadBlocking);
  40.   TClientType = (ctNonBlocking, ctBlocking);
  41.   TAsyncStyle = (asRead, asWrite, asOOB, asAccept, asConnect, asClose);
  42.   TAsyncStyles = set of TAsyncStyle;
  43.   TSocketEvent = (seLookup, seConnecting, seConnect, seDisconnect, seListen,
  44.     seAccept, seWrite, seRead);
  45.   TErrorEvent = (eeGeneral, eeSend, eeReceive, eeConnect, eeDisconnect, eeAccept);
  46.  
  47.   TSocketEventEvent = procedure (Sender: TObject; Socket: TCustomWinSocket;
  48.     SocketEvent: TSocketEvent) of object;
  49.   TSocketErrorEvent = procedure (Sender: TObject; Socket: TCustomWinSocket;
  50.     ErrorEvent: TErrorEvent; var ErrorCode: Integer) of object;
  51.   TGetSocketEvent = procedure (Sender: TObject; Socket: TSocket;
  52.     var ClientSocket: TServerClientWinSocket) of object;
  53.   TGetThreadEvent = procedure (Sender: TObject; ClientSocket: TServerClientWinSocket;
  54.     var SocketThread: TServerClientThread) of object;
  55.   TSocketNotifyEvent = procedure (Sender: TObject; Socket: TCustomWinSocket) of object;
  56.  
  57.   TCustomWinSocket = class
  58.   private
  59.     FSocket: TSocket;
  60.     FConnected: Boolean;
  61.     FSendStream: TStream;
  62.     FDropAfterSend: Boolean;
  63.     FHandle: HWnd;
  64.     FAddr: TSockAddrIn;
  65.     FAsyncStyles: TASyncStyles;
  66.     FOnSocketEvent: TSocketEventEvent;
  67.     FOnErrorEvent: TSocketErrorEvent;
  68.     FSocketLock: TCriticalSection;
  69.     FData: Pointer;
  70.     function SendStreamPiece: Boolean;
  71.     procedure DefaultHandler(var Message); override;
  72.     procedure WndProc(var Message: TMessage);
  73.     procedure CMSocketMessage(var Message: TCMSocketMessage); message CM_SOCKETMESSAGE;
  74.     procedure CMDeferFree(var Message); message CM_DEFERFREE;
  75.     procedure DeferFree;
  76.     procedure DoSetAsyncStyles;
  77.     function GetHandle: HWnd;
  78.     function GetLocalHost: string;
  79.     function GetLocalAddress: string;
  80.     function GetLocalPort: Integer;
  81.     function GetRemoteHost: string;
  82.     function GetRemoteAddress: string;
  83.     function GetRemotePort: Integer;
  84.     function GetRemoteAddr: TSockAddrIn;
  85.   protected
  86.     function InitSocket(var Name, Address, Service: string; Port: Word;
  87.       Client: Boolean): TSockAddrIn;
  88.     procedure Event(Socket: TCustomWinSocket; SocketEvent: TSocketEvent); dynamic;
  89.     procedure Error(Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  90.       var ErrorCode: Integer); dynamic;
  91.     procedure SetAsyncStyles(Value: TASyncStyles);
  92.     procedure Listen(var Name, Address, Service: string; Port: Word;
  93.       QueueSize: Integer);
  94.     procedure Open(var Name, Address, Service: string; Port: Word);
  95.     procedure Accept(Socket: TSocket); virtual;
  96.     procedure Connect(Socket: TSocket); virtual;
  97.     procedure Disconnect(Socket: TSocket); virtual;
  98.     procedure Read(Socket: TSocket); virtual;
  99.     procedure Write(Socket: TSocket); virtual;
  100.   public
  101.     constructor Create(ASocket: TSocket);
  102.     destructor Destroy; override;
  103.     procedure Close;
  104.     procedure Lock;
  105.     procedure Unlock;
  106.     function LookupName(const name: string) : TInAddr;
  107.     function LookupService(const service: string): Integer;
  108.  
  109.     function ReceiveLength: Integer;
  110.     function ReceiveBuf(var Buf; Count: Integer): Integer;
  111.     function ReceiveText: string;
  112.     function SendBuf(var Buf; Count: Integer): Integer;
  113.     function SendStream(AStream: TStream): Boolean;
  114.     function SendStreamThenDrop(AStream: TStream): Boolean;
  115.     procedure SendText(const S: string);
  116.  
  117.     property LocalHost: string read GetLocalHost;
  118.     property LocalAddress: string read GetLocalAddress;
  119.     property LocalPort: Integer read GetLocalPort;
  120.  
  121.     property RemoteHost: string read GetRemoteHost;
  122.     property RemoteAddress: string read GetRemoteAddress;
  123.     property RemotePort: Integer read GetRemotePort;
  124.     property RemoteAddr: TSockAddrIn read GetRemoteAddr;
  125.  
  126.     property Connected: Boolean read FConnected;
  127.     property Addr: TSockAddrIn read FAddr;
  128.     property ASyncStyles: TAsyncStyles read FAsyncStyles write SetAsyncStyles;
  129.     property Handle: HWnd read GetHandle;
  130.     property SocketHandle: TSocket read FSocket;
  131.  
  132.     property OnSocketEvent: TSocketEventEvent read FOnSocketEvent write FOnSocketEvent;
  133.     property OnErrorEvent: TSocketErrorEvent read FOnErrorEvent write FOnErrorEvent;
  134.  
  135.     property Data: Pointer read FData write FData;
  136.   end;
  137.  
  138.   TClientWinSocket = class(TCustomWinSocket)
  139.   private
  140.     FClientType: TClientType;
  141.   protected
  142.     procedure Connect(Socket: TSocket); override;
  143.     procedure SetClientType(Value: TClientType);
  144.   public
  145.     property ClientType: TClientType read FClientType write SetClientType;
  146.   end;
  147.  
  148.   TServerClientWinSocket = class(TCustomWinSocket)
  149.   private
  150.     FServerWinSocket: TServerWinSocket;
  151.   public
  152.     constructor Create(Socket: TSocket; ServerWinSocket: TServerWinSocket);
  153.     destructor Destroy; override;
  154.  
  155.     property ServerWinSocket: TServerWinSocket read FServerWinSocket;
  156.   end;
  157.  
  158.   TThreadNotifyEvent = procedure (Sender: TObject;
  159.     Thread: TServerClientThread) of object;
  160.  
  161.   TServerWinSocket = class(TCustomWinSocket)
  162.   private
  163.     FServerType: TServerType;
  164.     FThreadCacheSize: Integer;
  165.     FConnections: TList;
  166.     FActiveThreads: TList;
  167.     FListLock: TCriticalSection;
  168.     FServerAcceptThread: TServerAcceptThread;
  169.     FOnGetSocket: TGetSocketEvent;
  170.     FOnGetThread: TGetThreadEvent;
  171.     FOnThreadStart: TThreadNotifyEvent;
  172.     FOnThreadEnd: TThreadNotifyEvent;
  173.     FOnClientConnect: TSocketNotifyEvent;
  174.     FOnClientDisconnect: TSocketNotifyEvent;
  175.     FOnClientRead: TSocketNotifyEvent;
  176.     FOnClientWrite: TSocketNotifyEvent;
  177.     FOnClientError: TSocketErrorEvent;
  178.     procedure AddClient(AClient: TServerClientWinSocket);
  179.     procedure RemoveClient(AClient: TServerClientWinSocket);
  180.     procedure AddThread(AThread: TServerClientThread);
  181.     procedure RemoveThread(AThread: TServerClientThread);
  182.     procedure ClientEvent(Sender: TObject; Socket: TCustomWinSocket;
  183.       SocketEvent: TSocketEvent);
  184.     procedure ClientError(Sender: TObject; Socket: TCustomWinSocket;
  185.       ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  186.     function GetActiveConnections: Integer;
  187.     function GetActiveThreads: Integer;
  188.     function GetConnections(Index: Integer): TCustomWinSocket;
  189.     function GetIdleThreads: Integer;
  190.   protected
  191.     procedure Accept(Socket: TSocket); override;
  192.     procedure Disconnect(Socket: TSocket); override;
  193.     function DoCreateThread(ClientSocket: TServerClientWinSocket): TServerClientThread; virtual;
  194.     procedure Listen(var Name, Address, Service: string; Port: Word;
  195.       QueueSize: Integer);
  196.     procedure SetServerType(Value: TServerType);
  197.     procedure SetThreadCacheSize(Value: Integer);
  198.     procedure ThreadEnd(AThread: TServerClientThread); dynamic;
  199.     procedure ThreadStart(AThread: TServerClientThread); dynamic;
  200.     function GetClientSocket(Socket: TSocket): TServerClientWinSocket; dynamic;
  201.     function GetServerThread(ClientSocket: TServerClientWinSocket): TServerClientThread; dynamic;
  202.     procedure ClientRead(Socket: TCustomWinSocket); dynamic;
  203.     procedure ClientWrite(Socket: TCustomWinSOcket); dynamic;
  204.     procedure ClientConnect(Socket: TCustomWinSOcket); dynamic;
  205.     procedure ClientDisconnect(Socket: TCustomWinSOcket); dynamic;
  206.     procedure ClientErrorEvent(Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  207.       var ErrorCode: Integer); dynamic;
  208.   public
  209.     constructor Create(ASocket: TSocket);
  210.     destructor Destroy; override;
  211.     function GetClientThread(ClientSocket: TServerClientWinSocket): TServerClientThread;
  212.     property ActiveConnections: Integer read GetActiveConnections;
  213.     property ActiveThreads: Integer read GetActiveThreads;
  214.     property Connections[Index: Integer]: TCustomWinSocket read GetConnections;
  215.     property IdleThreads: Integer read GetIdleThreads;
  216.     property ServerType: TServerType read FServerType write SetServerType;
  217.     property ThreadCacheSize: Integer read FThreadCacheSize write SetThreadCacheSize;
  218.     property OnGetSocket: TGetSocketEvent read FOnGetSocket write FOnGetSocket;
  219.     property OnGetThread: TGetThreadEvent read FOnGetThread write FOnGetThread;
  220.     property OnThreadStart: TThreadNotifyEvent read FOnThreadStart write FOnThreadStart;
  221.     property OnThreadEnd: TThreadNotifyEvent read FOnThreadEnd write FOnThreadEnd;
  222.     property OnClientConnect: TSocketNotifyEvent read FOnClientConnect write FOnClientConnect;
  223.     property OnClientDisconnect: TSocketNotifyEvent read FOnClientDisconnect write FOnClientDisconnect;
  224.     property OnClientRead: TSocketNotifyEvent read FOnClientRead write FOnClientRead;
  225.     property OnClientWrite: TSocketNotifyEvent read FOnClientWrite write FOnClientWrite;
  226.     property OnClientError: TSocketErrorEvent read FOnClientError write FOnClientError;
  227.   end;
  228.  
  229.   TServerAcceptThread = class(TThread)
  230.   private
  231.     FServerSocket: TServerWinSocket;
  232.   public
  233.     constructor Create(CreateSuspended: Boolean; ASocket: TServerWinSocket);
  234.     procedure Execute; override;
  235.  
  236.     property ServerSocket: TServerWinSocket read FServerSocket;
  237.   end;
  238.  
  239.   TServerClientThread = class(TThread)
  240.   private
  241.     FClientSocket: TServerClientWinSocket;
  242.     FServerSocket: TServerWinSocket;
  243.     FException: Exception;
  244.     FEvent: TSimpleEvent;
  245.     FKeepInCache: Boolean;
  246.     FData: Pointer;
  247.     procedure HandleEvent(Sender: TObject; Socket: TCustomWinSocket;
  248.       SocketEvent: TSocketEvent);
  249.     procedure HandleError(Sender: TObject; Socket: TCustomWinSocket;
  250.       ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  251.     procedure DoHandleException;
  252.     procedure DoRead;
  253.     procedure DoWrite;
  254.   protected
  255.     procedure DoTerminate; override;
  256.     procedure Execute; override;
  257.     procedure ClientExecute; virtual;
  258.     procedure Event(SocketEvent: TSocketEvent); virtual;
  259.     procedure Error(ErrorEvent: TErrorEvent; var ErrorCode: Integer); virtual;
  260.     procedure HandleException; virtual;
  261.     procedure ReActivate(ASocket: TServerClientWinSocket);
  262.     function StartConnect: Boolean;
  263.     function EndConnect: Boolean;
  264.   public
  265.     constructor Create(CreateSuspended: Boolean; ASocket: TServerClientWinSocket);
  266.     destructor Destroy; override;
  267.  
  268.     property ClientSocket: TServerClientWinSocket read FClientSocket;
  269.     property ServerSocket: TServerWinSocket read FServerSocket;
  270.     property KeepInCache: Boolean read FKeepInCache write FKeepInCache;
  271.     property Data: Pointer read FData write FData;
  272.   end;
  273.  
  274.   TCustomSocket = class(TComponent)
  275.   private
  276.     FActive: Boolean;
  277.     FOnLookup: TSocketNotifyEvent;
  278.     FOnConnect: TSocketNotifyEvent;
  279.     FOnConnecting: TSocketNotifyEvent;
  280.     FOnDisconnect: TSocketNotifyEvent;
  281.     FOnListen: TSocketNotifyEvent;
  282.     FOnAccept: TSocketNotifyEvent;
  283.     FOnRead: TSocketNotifyEvent;
  284.     FOnWrite: TSocketNotifyEvent;
  285.     FOnError: TSocketErrorEvent;
  286.     FPort: Integer;
  287.     FAddress: string;
  288.     FHost: string;
  289.     FService: string;
  290.     procedure DoEvent(Sender: TObject; Socket: TCustomWinSocket;
  291.       SocketEvent: TSocketEvent);
  292.     procedure DoError(Sender: TObject; Socket: TCustomWinSocket;
  293.       ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  294.   protected
  295.     procedure Event(Socket: TCustomWinSocket; SocketEvent: TSocketEvent); virtual;
  296.     procedure Error(Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  297.       var ErrorCode: Integer); virtual;
  298.     procedure DoActivate(Value: Boolean); virtual; abstract;
  299.     procedure Loaded; override;
  300.     procedure SetActive(Value: Boolean);
  301.     procedure SetAddress(Value: string);
  302.     procedure SetHost(Value: string);
  303.     procedure SetPort(Value: Integer);
  304.     procedure SetService(Value: string);
  305.     property Active: Boolean read FActive write SetActive;
  306.     property Address: string read FAddress write SetAddress;
  307.     property Host: string read FHost write SetHost;
  308.     property Port: Integer read FPort write SetPort;
  309.     property Service: string read FService write SetService;
  310.     property OnLookup: TSocketNotifyEvent read FOnLookup write FOnLookup;
  311.     property OnConnecting: TSocketNotifyEvent read FOnConnecting write FOnConnecting;
  312.     property OnConnect: TSocketNotifyEvent read FOnConnect write FOnConnect;
  313.     property OnDisconnect: TSocketNotifyEvent read FOnDisconnect write FOnDisconnect;
  314.     property OnListen: TSocketNotifyEvent read FOnListen write FOnListen;
  315.     property OnAccept: TSocketNotifyEvent read FOnAccept write FOnAccept;
  316.     property OnRead: TSocketNotifyEvent read FOnRead write FOnRead;
  317.     property OnWrite: TSocketNotifyEvent read FOnWrite write FOnWrite;
  318.     property OnError: TSocketErrorEvent read FOnError write FOnError;
  319.   public
  320.     procedure Open;
  321.     procedure Close;
  322.   end;
  323.  
  324.   TWinSocketStream = class(TStream)
  325.   private
  326.     FSocket: TCustomWinSocket;
  327.     FTimeout: Longint;
  328.     FEvent: TSimpleEvent;
  329.   public
  330.     constructor Create(ASocket: TCustomWinSocket; TimeOut: Longint);
  331.     destructor Destroy; override;
  332.     function WaitForData(Timeout: Longint): Boolean;
  333.     function Read(var Buffer; Count: Longint): Longint; override;
  334.     function Write(const Buffer; Count: Longint): Longint; override;
  335.     function Seek(Offset: Longint; Origin: Word): Longint; override;
  336.     property TimeOut: Longint read FTimeout write FTimeout;
  337.   end;
  338.  
  339.   TClientSocket = class(TCustomSocket)
  340.   private
  341.     FClientSocket: TClientWinSocket;
  342.     procedure DoActivate(Value: Boolean); override;
  343.   protected
  344.     function GetClientType: TClientType;
  345.     procedure SetClientType(Value: TClientType);
  346.   public
  347.     constructor Create(AOwner: TComponent); override;
  348.     destructor Destroy; override;
  349.     property Socket: TClientWinSocket read FClientSocket;
  350.   published
  351.     property Active;
  352.     property Address;
  353.     property ClientType: TClientType read GetClientType write SetClientType;
  354.     property Host;
  355.     property Port;
  356.     property Service;
  357.     property OnLookup;
  358.     property OnConnecting;
  359.     property OnConnect;
  360.     property OnDisconnect;
  361.     property OnRead;
  362.     property OnWrite;
  363.     property OnError;
  364.   end;
  365.  
  366.   TCustomServerSocket = class(TCustomSocket)
  367.   private
  368.     procedure DoActivate(Value: Boolean); override;
  369.   protected
  370.     FServerSocket: TServerWinSocket;
  371.     function GetServerType: TServerType;
  372.     function GetGetThreadEvent: TGetThreadEvent;
  373.     function GetGetSocketEvent: TGetSocketEvent;
  374.     function GetThreadCacheSize: Integer;
  375.     function GetOnThreadStart: TThreadNotifyEvent;
  376.     function GetOnThreadEnd: TThreadNotifyEvent;
  377.     function GetOnClientEvent(Index: Integer): TSocketNotifyEvent;
  378.     function GetOnClientError: TSocketErrorEvent;
  379.     procedure SetServerType(Value: TServerType);
  380.     procedure SetGetThreadEvent(Value: TGetThreadEvent);
  381.     procedure SetGetSocketEvent(Value: TGetSocketEvent);
  382.     procedure SetThreadCacheSize(Value: Integer);
  383.     procedure SetOnThreadStart(Value: TThreadNotifyEvent);
  384.     procedure SetOnThreadEnd(Value: TThreadNotifyEvent);
  385.     procedure SetOnClientEvent(Index: Integer; Value: TSocketNotifyEvent);
  386.     procedure SetOnClientError(Value: TSocketErrorEvent);
  387.     property ServerType: TServerType read GetServerType write SetServerType;
  388.     property ThreadCacheSize: Integer read GetThreadCacheSize
  389.       write SetThreadCacheSize;
  390.     property OnGetThread: TGetThreadEvent read GetGetThreadEvent
  391.       write SetGetThreadEvent;
  392.     property OnGetSocket: TGetSocketEvent read GetGetSocketEvent
  393.       write SetGetSocketEvent;
  394.     property OnThreadStart: TThreadNotifyEvent read GetOnThreadStart
  395.       write SetOnThreadStart;
  396.     property OnThreadEnd: TThreadNotifyEvent read GetOnThreadEnd
  397.       write SetOnThreadEnd;
  398.     property OnClientConnect: TSocketNotifyEvent index 2 read GetOnClientEvent
  399.       write SetOnClientEvent;
  400.     property OnClientDisconnect: TSocketNotifyEvent index 3 read GetOnClientEvent
  401.       write SetOnClientEvent;
  402.     property OnClientRead: TSocketNotifyEvent index 0 read GetOnClientEvent
  403.       write SetOnClientEvent;
  404.     property OnClientWrite: TSocketNotifyEvent index 1 read GetOnClientEvent
  405.       write SetOnClientEvent;
  406.     property OnClientError: TSocketErrorEvent read GetOnClientError write SetOnClientError;
  407.   public
  408.     destructor Destroy; override;
  409.   end;
  410.  
  411.   TServerSocket = class(TCustomServerSocket)
  412.   public
  413.     constructor Create(AOwner: TComponent); override;
  414.     property Socket: TServerWinSocket read FServerSocket;
  415.   published
  416.     property Active;
  417.     property Port;
  418.     property Service;
  419.     property ServerType;
  420.     property ThreadCacheSize default 10;
  421.     property OnListen;
  422.     property OnAccept;
  423.     property OnGetThread;
  424.     property OnGetSocket;
  425.     property OnThreadStart;
  426.     property OnThreadEnd;
  427.     property OnClientConnect;
  428.     property OnClientDisconnect;
  429.     property OnClientRead;
  430.     property OnClientWrite;
  431.     property OnClientError;
  432.   end;
  433.  
  434. threadvar
  435.   SocketErrorProc: procedure (ErrorCode: Integer);
  436.  
  437. implementation
  438.  
  439. uses Forms, WebConst;
  440.  
  441. var
  442.   WSAData: TWSAData;
  443.  
  444. function CheckSocketResult(ResultCode: Integer; const Op: string): Integer;
  445. begin
  446.   if ResultCode <> 0 then
  447.   begin
  448.     Result := WSAGetLastError;
  449.     if Result <> WSAEWOULDBLOCK then
  450.       if Assigned(SocketErrorProc) then
  451.         SocketErrorProc(Result)
  452.       else raise ESocketError.CreateFmt(sWindowsSocketError,
  453.         [SysErrorMessage(Result), Result, Op]);
  454.   end else Result := 0;
  455. end;
  456.  
  457. procedure Startup;
  458. var
  459.   ErrorCode: Integer;
  460. begin
  461.   ErrorCode := WSAStartup($0101, WSAData);
  462.   if ErrorCode <> 0 then
  463.     raise ESocketError.CreateFmt(sWindowsSocketError,
  464.       [SysErrorMessage(ErrorCode), ErrorCode, 'WSAStartup']);
  465. end;
  466.  
  467. procedure Cleanup;
  468. var
  469.   ErrorCode: Integer;
  470. begin
  471.   ErrorCode := WSACleanup;
  472.   if ErrorCode <> 0 then
  473.     raise ESocketError.CreateFmt(sWindowsSocketError,
  474.       [SysErrorMessage(ErrorCode), ErrorCode, 'WSACleanup']);
  475. end;
  476.  
  477. { TCustomWinSocket }
  478.  
  479. constructor TCustomWinSocket.Create(ASocket: TSocket);
  480. begin
  481.   inherited Create;
  482.   Startup;
  483.   FSocketLock := TCriticalSection.Create;
  484.   FASyncStyles := [asRead, asWrite, asConnect, asClose];
  485.   FSocket := ASocket;
  486.   FAddr.sin_family := PF_INET;
  487.   FAddr.sin_addr.s_addr := INADDR_ANY;
  488.   FAddr.sin_port := 0;
  489.   FConnected := FSocket <> INVALID_SOCKET;
  490. end;
  491.  
  492. destructor TCustomWinSocket.Destroy;
  493. begin
  494.   FOnSocketEvent := nil;  { disable events }
  495.   if FConnected and (FSocket <> INVALID_SOCKET) then
  496.     Disconnect(FSocket);
  497.   if FHandle <> 0 then DeallocateHWnd(FHandle);
  498.   FSocketLock.Free;
  499.   Cleanup;
  500.   inherited Destroy;
  501. end;
  502.  
  503. procedure TCustomWinSocket.Accept(Socket: TSocket);
  504. begin
  505. end;
  506.  
  507. procedure TCustomWinSocket.Close;
  508. begin
  509.   Disconnect(FSocket);
  510. end;
  511.  
  512. procedure TCustomWinSocket.Connect(Socket: TSocket);
  513. begin
  514. end;
  515.  
  516. procedure TCustomWinSocket.Lock;
  517. begin
  518.   FSocketLock.Enter;
  519. end;
  520.  
  521. procedure TCustomWinSocket.Unlock;
  522. begin
  523.   FSocketLock.Leave;
  524. end;
  525.  
  526. procedure TCustomWinSocket.CMSocketMessage(var Message: TCMSocketMessage);
  527.  
  528.   function CheckError: Boolean;
  529.   var
  530.     ErrorEvent: TErrorEvent;
  531.     ErrorCode: Integer;
  532.   begin
  533.     if Message.SelectError <> 0 then
  534.     begin
  535.       Result := False;
  536.       ErrorCode := Message.SelectError;
  537.       case Message.SelectEvent of
  538.         FD_CONNECT: ErrorEvent := eeConnect;
  539.         FD_CLOSE: ErrorEvent := eeDisconnect;
  540.         FD_READ: ErrorEvent := eeReceive;
  541.         FD_WRITE: ErrorEvent := eeSend;
  542.         FD_ACCEPT: ErrorEvent := eeAccept;
  543.       else
  544.         ErrorEvent := eeGeneral;
  545.       end;
  546.       Error(Self, ErrorEvent, ErrorCode);
  547.       if ErrorCode <> 0 then
  548.         raise ESocketError.CreateFmt(sASyncSocketError, [ErrorCode]);
  549.     end else Result := True;
  550.   end;
  551.  
  552. begin
  553.   with Message do
  554.     if CheckError then
  555.       case SelectEvent of
  556.         FD_CONNECT: Connect(Socket);
  557.         FD_CLOSE: Disconnect(Socket);
  558.         FD_READ: Read(Socket);
  559.         FD_WRITE: Write(Socket);
  560.         FD_ACCEPT: Accept(Socket);
  561.       end;
  562. end;
  563.  
  564. procedure TCustomWinSocket.CMDeferFree(var Message);
  565. begin
  566.   Free;
  567. end;
  568.  
  569. procedure TCustomWinSocket.DeferFree;
  570. begin
  571.   if FHandle <> 0 then PostMessage(FHandle, CM_DEFERFREE, 0, 0);
  572. end;
  573.  
  574. procedure TCustomWinSocket.DoSetAsyncStyles;
  575. var
  576.   Msg: Integer;
  577.   Wnd: HWnd;
  578.   Blocking: Longint;
  579. begin
  580.   Msg := 0;
  581.   Wnd := 0;
  582.   if FAsyncStyles <> [] then
  583.   begin
  584.     Msg := CM_SOCKETMESSAGE;
  585.     Wnd := Handle;
  586.   end;
  587.   WSAAsyncSelect(FSocket, Wnd, Msg, Longint(Byte(FAsyncStyles)));
  588.   if FASyncStyles = [] then
  589.   begin
  590.     Blocking := 0;
  591.     ioctlsocket(FSocket, FIONBIO, Blocking);
  592.   end;
  593. end;
  594.  
  595. function TCustomWinSocket.GetHandle: HWnd;
  596. begin
  597.   if FHandle = 0 then
  598.     FHandle := AllocateHwnd(WndProc);
  599.   Result := FHandle;
  600. end;
  601.  
  602. function TCustomWinSocket.GetLocalAddress: string;
  603. var
  604.   SockAddrIn: TSockAddrIn;
  605.   Size: Integer;
  606. begin
  607.   Lock;
  608.   try
  609.     Result := '';
  610.     if FSocket = INVALID_SOCKET then Exit;
  611.     Size := SizeOf(SockAddrIn);
  612.     if getsockname(FSocket, SockAddrIn, Size) = 0 then
  613.       Result := inet_ntoa(SockAddrIn.sin_addr);
  614.   finally
  615.     Unlock;
  616.   end;
  617. end;
  618.  
  619. function TCustomWinSocket.GetLocalHost: string;
  620. var
  621.   LocalName: array[0..255] of Char;
  622. begin
  623.   Lock;
  624.   try
  625.     Result := '';
  626.     if FSocket = INVALID_SOCKET then Exit;
  627.     if gethostname(LocalName, SizeOf(LocalName)) = 0 then
  628.       Result := LocalName;
  629.   finally
  630.     Unlock;
  631.   end;
  632. end;
  633.  
  634. function TCustomWinSocket.GetLocalPort: Integer;
  635. var
  636.   SockAddrIn: TSockAddrIn;
  637.   Size: Integer;
  638. begin
  639.   Lock;
  640.   try
  641.     Result := -1;
  642.     if FSocket = INVALID_SOCKET then Exit;
  643.     Size := SizeOf(SockAddrIn);
  644.     if getsockname(FSocket, SockAddrIn, Size) = 0 then
  645.       Result := ntohs(SockAddrIn.sin_port);
  646.   finally
  647.     Unlock;
  648.   end;
  649. end;
  650.  
  651. function TCustomWinSocket.GetRemoteHost: string;
  652. var
  653.   SockAddrIn: TSockAddrIn;
  654.   Size: Integer;
  655.   HostEnt: PHostEnt;
  656. begin
  657.   Lock;
  658.   try
  659.     Result := '';
  660.     if not FConnected then Exit;
  661.     Size := SizeOf(SockAddrIn);
  662.     CheckSocketResult(getpeername(FSocket, SockAddrIn, Size), 'getpeername');
  663.     HostEnt := gethostbyaddr(@SockAddrIn.sin_addr.s_addr, 4, PF_INET);
  664.     if HostEnt <> nil then Result := HostEnt.h_name;
  665.   finally
  666.     Unlock;
  667.   end;
  668. end;
  669.  
  670. function TCustomWinSocket.GetRemoteAddress: string;
  671. var
  672.   SockAddrIn: TSockAddrIn;
  673.   Size: Integer;
  674. begin
  675.   Lock;
  676.   try
  677.     Result := '';
  678.     if not FConnected then Exit;
  679.     Size := SizeOf(SockAddrIn);
  680.     CheckSocketResult(getpeername(FSocket, SockAddrIn, Size), 'getpeername');
  681.     Result := inet_ntoa(SockAddrIn.sin_addr);
  682.   finally
  683.     Unlock;
  684.   end;
  685. end;
  686.  
  687. function TCustomWinSocket.GetRemotePort: Integer;
  688. var
  689.   SockAddrIn: TSockAddrIn;
  690.   Size: Integer;
  691. begin
  692.   Lock;
  693.   try
  694.     Result := 0;
  695.     if not FConnected then Exit;
  696.     Size := SizeOf(SockAddrIn);
  697.     CheckSocketResult(getpeername(FSocket, SockAddrIn, Size), 'getpeername');
  698.     Result := ntohs(SockAddrIn.sin_port);
  699.   finally
  700.     Unlock;
  701.   end;
  702. end;
  703.  
  704. function TCustomWinSocket.GetRemoteAddr: TSockAddrIn;
  705. var
  706.   Size: Integer;
  707. begin
  708.   Lock;
  709.   try
  710.     FillChar(Result, SizeOf(Result), 0);
  711.     if not FConnected then Exit;
  712.     Size := SizeOf(Result);
  713.     if getpeername(FSocket, Result, Size) <> 0 then
  714.       FillChar(Result, SizeOf(Result), 0);
  715.   finally
  716.     Unlock;
  717.   end;
  718. end;
  719.  
  720. function TCustomWinSocket.LookupName(const Name: string): TInAddr;
  721. var
  722.   HostEnt: PHostEnt;
  723.   InAddr: TInAddr;
  724. begin
  725.   HostEnt := gethostbyname(PChar(Name));
  726.   FillChar(InAddr, SizeOf(InAddr), 0);
  727.   if HostEnt <> nil then
  728.   begin
  729.     with InAddr, HostEnt^ do
  730.     begin
  731.       S_un_b.s_b1 := h_addr^[0];
  732.       S_un_b.s_b2 := h_addr^[1];
  733.       S_un_b.s_b3 := h_addr^[2];
  734.       S_un_b.s_b4 := h_addr^[3];
  735.     end;
  736.   end;
  737.   Result := InAddr;
  738. end;
  739.  
  740. function TCustomWinSocket.LookupService(const Service: string): Integer;
  741. var
  742.   ServEnt: PServEnt;
  743. begin
  744.   ServEnt := getservbyname(PChar(Service), 'tcp');
  745.   if ServEnt <> nil then
  746.     Result := ntohs(ServEnt.s_port)
  747.   else Result := 0;
  748. end;
  749.  
  750. function TCustomWinSocket.InitSocket(var Name, Address, Service: string; Port: Word;
  751.   Client: Boolean): TSockAddrIn;
  752. begin
  753.   Result.sin_family := PF_INET;
  754.   if Name <> '' then
  755.     Result.sin_addr := LookupName(name)
  756.   else if Address <> '' then
  757.     Result.sin_addr.s_addr := inet_addr(PChar(Address))
  758.   else if not Client then
  759.     Result.sin_addr.s_addr := INADDR_ANY
  760.   else raise ESocketError.Create(sNoAddress);
  761.   if Service <> '' then
  762.     Result.sin_port := htons(LookupService(Service))
  763.   else
  764.     Result.sin_port := htons(Port);
  765. end;
  766.  
  767. procedure TCustomWinSocket.Listen(var Name, Address, Service: string; Port: Word;
  768.   QueueSize: Integer);
  769. var
  770.   SockAddrIn: TSockAddrIn;
  771. begin
  772.   if FConnected then raise ESocketError.Create(sCannotListenOnOpen);
  773.   FSocket := socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
  774.   if FSocket = INVALID_SOCKET then raise ESocketError.Create(sCannotCreateSocket);
  775.   try
  776.     SockAddrIn := InitSocket(Name, Address, Service, Port, False);
  777.     CheckSocketResult(bind(FSocket, SockAddrIn, SizeOf(SockAddrIn)), 'bind');
  778.     DoSetASyncStyles;
  779.     if QueueSize > SOMAXCONN then QueueSize := SOMAXCONN;
  780.     Event(Self, seListen);
  781.     CheckSocketResult(Winsock.listen(FSocket, QueueSize), 'listen');
  782.     FConnected := True;
  783.   except
  784.     Disconnect(FSocket);
  785.     raise;
  786.   end;
  787. end;
  788.  
  789. procedure TCustomWinSocket.Open(var Name, Address, Service: string; Port: Word);
  790. var
  791.   SockAddrIn: TSockAddrIn;
  792. begin
  793.   if FConnected then raise ESocketError.Create(sSocketAlreadyOpen);
  794.   FSocket := socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
  795.   if FSocket = INVALID_SOCKET then raise ESocketError.Create(sCannotCreateSocket);
  796.   try
  797.     Event(Self, seLookUp);
  798.     SockAddrIn := InitSocket(Name, Address, Service, Port, True);
  799.     DoSetASyncStyles;
  800.     Event(Self, seConnecting);
  801.     CheckSocketResult(WinSock.connect(FSocket, SockAddrIn, SizeOf(SockAddrIn)), 'connect');
  802.     if not (asConnect in FAsyncStyles) then
  803.     begin
  804.       FConnected := FSocket <> INVALID_SOCKET;
  805.       Event(Self, seConnect);
  806.     end;
  807.   except
  808.     Disconnect(FSocket);
  809.     raise;
  810.   end;
  811. end;
  812.  
  813. procedure TCustomWinSocket.Disconnect(Socket: TSocket);
  814. begin
  815.   Lock;
  816.   try
  817.     if (Socket = INVALID_SOCKET) or (Socket <> FSocket) then exit;
  818.     Event(Self, seDisconnect);
  819.     CheckSocketResult(closesocket(FSocket), 'closesocket');
  820.     FSocket := INVALID_SOCKET;
  821.     FConnected := False;
  822.     FSendStream.Free;
  823.     FSendStream := nil;
  824.   finally
  825.     Unlock;
  826.   end;
  827. end;
  828.  
  829. procedure TCustomWinSocket.DefaultHandler(var Message);
  830. begin
  831.   with TMessage(Message) do
  832.     if FHandle <> 0 then
  833.       Result := CallWindowProc(@DefWindowProc, FHandle, Msg, wParam, lParam);
  834. end;
  835.  
  836. procedure TCustomWinSocket.Event(Socket: TCustomWinSocket; SocketEvent: TSocketEvent);
  837. begin
  838.   if Assigned(FOnSocketEvent) then FOnSocketEvent(Self, Socket, SocketEvent);
  839. end;
  840.  
  841. procedure TCustomWinSocket.Error(Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  842.   var ErrorCode: Integer);
  843. begin
  844.   if Assigned(FOnErrorEvent) then FOnErrorEvent(Self, Socket, ErrorEvent, ErrorCode);
  845. end;
  846.  
  847. procedure TCustomWinSocket.SendText(const s: string);
  848. begin
  849.   SendBuf(Pointer(S)^, Length(S));
  850. end;
  851.  
  852. function TCustomWinSocket.SendStreamPiece: Boolean;
  853. var
  854.   Buffer: array[0..4095] of Byte;
  855.   StartPos: Integer;
  856.   AmountInBuf: Integer;
  857.   AmountSent: Integer;
  858.   ErrorCode: Integer;
  859.  
  860.   procedure DropStream;
  861.   begin
  862.     if FDropAfterSend then Disconnect(FSocket);
  863.     FDropAfterSend := False;
  864.     FSendStream.Free;
  865.     FSendStream := nil;
  866.   end;
  867.  
  868. begin
  869.   Lock;
  870.   try
  871.     Result := False;
  872.     if FSendStream <> nil then
  873.     begin
  874.       if (FSocket = INVALID_SOCKET) or (not FConnected) then exit;
  875.       while True do
  876.       begin
  877.         StartPos := FSendStream.Position;
  878.         AmountInBuf := FSendStream.Read(Buffer, SizeOf(Buffer));
  879.         if AmountInBuf > 0 then
  880.         begin
  881.           AmountSent := send(FSocket, Buffer, AmountInBuf, 0);
  882.           if AmountSent = SOCKET_ERROR then
  883.           begin
  884.             ErrorCode := WSAGetLastError;
  885.             if ErrorCode <> WSAEWOULDBLOCK then
  886.             begin
  887.               Error(Self, eeSend, ErrorCode);
  888.               Disconnect(FSocket);
  889.               DropStream;
  890.               if FAsyncStyles <> [] then Abort;
  891.               Break;
  892.             end else
  893.             begin
  894.               FSendStream.Position := StartPos;
  895.               Break;
  896.             end;
  897.           end else if AmountInBuf > AmountSent then
  898.             FSendStream.Position := StartPos + (AmountInBuf - AmountSent)
  899.           else if FSendStream.Position = FSendStream.Size then
  900.           begin
  901.             DropStream;
  902.             Break;
  903.           end;
  904.         end else
  905.         begin
  906.           DropStream;
  907.           Break;
  908.         end;
  909.       end;
  910.       Result := True;
  911.     end;
  912.   finally
  913.     Unlock;
  914.   end;
  915. end;
  916.  
  917. function TCustomWinSocket.SendStream(AStream: TStream): Boolean;
  918. begin
  919.   Result := False;
  920.   if FSendStream = nil then
  921.   begin
  922.     FSendStream := AStream;
  923.     Result := SendStreamPiece;
  924.   end;
  925. end;
  926.  
  927. function TCustomWinSocket.SendStreamThenDrop(AStream: TStream): Boolean;
  928. begin
  929.   FDropAfterSend := True;
  930.   Result := SendStream(AStream);
  931.   if not Result then FDropAfterSend := False;
  932. end;
  933.  
  934. function TCustomWinSocket.SendBuf(var Buf; Count: Integer): Integer;
  935. var
  936.   ErrorCode: Integer;
  937. begin
  938.   Lock;
  939.   try
  940.     Result := 0;
  941.     if not FConnected then Exit;
  942.     Result := send(FSocket, Buf, Count, 0);
  943.     if Result = SOCKET_ERROR then
  944.     begin
  945.       ErrorCode := WSAGetLastError;
  946.       if (ErrorCode <> WSAEWOULDBLOCK) then
  947.       begin
  948.         Error(Self, eeSend, ErrorCode);
  949.         Disconnect(FSocket);
  950.         if ErrorCode <> 0 then
  951.           raise ESocketError.CreateFmt(sWindowsSocketError,
  952.             [SysErrorMessage(ErrorCode), ErrorCode, 'send']);
  953.       end;
  954.     end;
  955.   finally
  956.     Unlock;
  957.   end;
  958. end;
  959.  
  960. procedure TCustomWinSocket.SetAsyncStyles(Value: TASyncStyles);
  961. begin
  962.   if Value <> FASyncStyles then
  963.   begin
  964.     FASyncStyles := Value;
  965.     if FSocket <> INVALID_SOCKET then
  966.       DoSetAsyncStyles;
  967.   end;
  968. end;
  969.  
  970. procedure TCustomWinSocket.Read(Socket: TSocket);
  971. begin
  972.   if (FSocket = INVALID_SOCKET) or (Socket <> FSocket) then Exit;
  973.   Event(Self, seRead);
  974. end;
  975.  
  976. function TCustomWinSocket.ReceiveBuf(var Buf; Count: Integer): Integer;
  977. var
  978.   ErrorCode: Integer;
  979. begin
  980.   Lock;
  981.   try
  982.     Result := 0;
  983.     if (Count = -1) and FConnected then
  984.       ioctlsocket(FSocket, FIONREAD, Longint(Result))
  985.     else begin
  986.       if not FConnected then Exit;
  987.       Result := recv(FSocket, Buf, Count, 0);
  988.       if Result = SOCKET_ERROR then
  989.       begin
  990.         ErrorCode := WSAGetLastError;
  991.         if ErrorCode <> WSAEWOULDBLOCK then
  992.         begin
  993.           Error(Self, eeReceive, ErrorCode);
  994.           Disconnect(FSocket);
  995.           if ErrorCode <> 0 then
  996.             raise ESocketError.CreateFmt(sWindowsSocketError,
  997.               [SysErrorMessage(ErrorCode), ErrorCode, 'recv']);
  998.         end;
  999.       end;
  1000.     end;
  1001.   finally
  1002.     Unlock;
  1003.   end;
  1004. end;
  1005.  
  1006. function TCustomWinSocket.ReceiveLength: Integer;
  1007. begin
  1008.   Result := ReceiveBuf(Pointer(nil)^, -1);
  1009. end;
  1010.  
  1011. function TCustomWinSocket.ReceiveText: string;
  1012. var
  1013.   Buf: array [0..4095] of Char;
  1014.   Temp: string;
  1015.   Bytes: Integer;
  1016. begin
  1017.   Bytes := ReceiveBuf(Buf, sizeof(Buf));
  1018.   while Bytes > 0 do
  1019.   begin
  1020.     SetString(Temp, Buf, Bytes);
  1021.     Result := Result + Temp;
  1022.     Bytes := ReceiveBuf(Buf, sizeof(Buf));
  1023.   end;
  1024. end;
  1025.  
  1026. procedure TCustomWinSocket.WndProc(var Message: TMessage);
  1027. begin
  1028.   try
  1029.     Dispatch(Message);
  1030.   except
  1031.     Application.HandleException(Self);
  1032.   end;
  1033. end;
  1034.  
  1035. procedure TCustomWinSocket.Write(Socket: TSocket);
  1036. begin
  1037.   if (FSocket = INVALID_SOCKET) or (Socket <> FSocket) then Exit;
  1038.   if not SendStreamPiece then Event(Self, seWrite);
  1039. end;
  1040.  
  1041. { TClientWinSocket }
  1042.  
  1043. procedure TClientWinSocket.Connect(Socket: TSocket);
  1044. begin
  1045.   FConnected := True;
  1046.   Event(Self, seConnect);
  1047. end;
  1048.  
  1049. procedure TClientWinSocket.SetClientType(Value: TClientType);
  1050. begin
  1051.   if Value <> FClientType then
  1052.     if not FConnected then
  1053.     begin
  1054.       FClientType := Value;
  1055.       if FClientType = ctBlocking then
  1056.         ASyncStyles := []
  1057.       else ASyncStyles := [asRead, asWrite, asConnect, asClose];
  1058.     end else raise ESocketError.Create(sCantChangeWhileActive);
  1059. end;
  1060.  
  1061. { TServerClientWinsocket }
  1062.  
  1063. constructor TServerClientWinSocket.Create(Socket: TSocket; ServerWinSocket: TServerWinSocket);
  1064. begin
  1065.   FServerWinSocket := ServerWinSocket;
  1066.   if Assigned(FServerWinSocket) then
  1067.   begin
  1068.     FServerWinSocket.AddClient(Self);
  1069.     if FServerWinSocket.AsyncStyles <> [] then
  1070.       OnSocketEvent := FServerWinSocket.ClientEvent;
  1071.   end;
  1072.   inherited Create(Socket);
  1073.   if FServerWinSocket.ASyncStyles <> [] then DoSetAsyncStyles;
  1074.   if FConnected then Event(Self, seConnect);
  1075. end;
  1076.  
  1077. destructor TServerClientWinSocket.Destroy;
  1078. begin
  1079.   if Assigned(FServerWinSocket) then
  1080.     FServerWinSocket.RemoveClient(Self);
  1081.   inherited Destroy;
  1082. end;
  1083.  
  1084. { TServerWinSocket }
  1085.  
  1086. constructor TServerWinSocket.Create(ASocket: TSocket);
  1087. begin
  1088.   FConnections := TList.Create;
  1089.   FActiveThreads := TList.Create;
  1090.   FListLock := TCriticalSection.Create;
  1091.   inherited Create(ASocket);
  1092.   FAsyncStyles := [asAccept];
  1093. end;
  1094.  
  1095. destructor TServerWinSocket.Destroy;
  1096. begin
  1097.   inherited Destroy;
  1098.   FConnections.Free;
  1099.   FActiveThreads.Free;
  1100.   FListLock.Free;
  1101. end;
  1102.  
  1103. procedure TServerWinSocket.AddClient(AClient: TServerClientWinSocket);
  1104. begin
  1105.   FListLock.Enter;
  1106.   try
  1107.     if FConnections.IndexOf(AClient) < 0 then
  1108.       FConnections.Add(AClient);
  1109.   finally
  1110.     FListLock.Leave;
  1111.   end;
  1112. end;
  1113.  
  1114. procedure TServerWinSocket.RemoveClient(AClient: TServerClientWinSocket);
  1115. begin
  1116.   FListLock.Enter;
  1117.   try
  1118.     FConnections.Remove(AClient);
  1119.   finally
  1120.     FListLock.Leave;
  1121.   end;
  1122. end;
  1123.  
  1124. procedure TServerWinSocket.AddThread(AThread: TServerClientThread);
  1125. begin
  1126.   FListLock.Enter;
  1127.   try
  1128.     if FActiveThreads.IndexOf(AThread) < 0 then
  1129.     begin
  1130.       FActiveThreads.Add(AThread);
  1131.       if FActiveThreads.Count <= FThreadCacheSize then
  1132.         AThread.KeepInCache := True;
  1133.     end;
  1134.   finally
  1135.     FListLock.Leave;
  1136.   end;
  1137. end;
  1138.  
  1139. procedure TServerWinSocket.RemoveThread(AThread: TServerClientThread);
  1140. begin
  1141.   FListLock.Enter;
  1142.   try
  1143.     FActiveThreads.Remove(AThread);
  1144.   finally
  1145.     FListLock.Leave;
  1146.   end;
  1147. end;
  1148.  
  1149. procedure TServerWinSocket.ClientEvent(Sender: TObject; Socket: TCustomWinSocket;
  1150.   SocketEvent: TSocketEvent);
  1151. begin
  1152.   case SocketEvent of
  1153.     seAccept,
  1154.     seLookup,
  1155.     seConnecting,
  1156.     seListen:
  1157.       begin end;
  1158.     seConnect: ClientConnect(Socket);
  1159.     seDisconnect: ClientDisconnect(Socket);
  1160.     seRead: ClientRead(Socket);
  1161.     seWrite: ClientWrite(Socket);
  1162.   end;
  1163. end;
  1164.  
  1165. procedure TServerWinSocket.ClientError(Sender: TObject; Socket: TCustomWinSocket;
  1166.   ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  1167. begin
  1168.   ClientErrorEvent(Socket, ErrorEvent, ErrorCode);
  1169. end;
  1170.  
  1171. function TServerWinSocket.GetActiveConnections: Integer;
  1172. begin
  1173.   Result := FConnections.Count;
  1174. end;
  1175.  
  1176. function TServerWinSocket.GetConnections(Index: Integer): TCustomWinSocket;
  1177. begin
  1178.   Result := FConnections[Index];
  1179. end;
  1180.  
  1181. function TServerWinSocket.GetActiveThreads: Integer;
  1182. var
  1183.   I: Integer;
  1184. begin
  1185.   FListLock.Enter;
  1186.   try
  1187.     Result := 0;
  1188.     for I := 0 to FActiveThreads.Count - 1 do
  1189.       if TServerClientThread(FActiveThreads[I]).ClientSocket <> nil then
  1190.         Inc(Result);
  1191.   finally
  1192.     FListLock.Leave;
  1193.   end;
  1194. end;
  1195.  
  1196. function TServerWinSocket.GetIdleThreads: Integer;
  1197. var
  1198.   I: Integer;
  1199. begin
  1200.   FListLock.Enter;
  1201.   try
  1202.     Result := 0;
  1203.     for I := 0 to FActiveThreads.Count - 1 do
  1204.       if TServerClientThread(FActiveThreads[I]).ClientSocket = nil then
  1205.         Inc(Result);
  1206.   finally
  1207.     FListLock.Leave;
  1208.   end;
  1209. end;
  1210.  
  1211. procedure TServerWinSocket.Accept(Socket: TSocket);
  1212. var
  1213.   ClientSocket: TServerClientWinSocket;
  1214.   ClientWinSocket: TSocket;
  1215.   Addr: TSockAddrIn;
  1216.   Len: Integer;
  1217.   OldOpenType, NewOpenType: Integer;
  1218. begin
  1219.   Len := SizeOf(OldOpenType);
  1220.   if getsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, PChar(@OldOpenType),
  1221.     Len) = 0 then
  1222.   try
  1223.     if FServerType = stThreadBlocking then
  1224.     begin
  1225.       NewOpenType := SO_SYNCHRONOUS_NONALERT;
  1226.       setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, PChar(@NewOpenType), Len);
  1227.     end;
  1228.     Len := SizeOf(Addr);
  1229.     ClientWinSocket := WinSock.accept(Socket, @Addr, @Len);
  1230.     if ClientWinSocket <> INVALID_SOCKET then
  1231.     begin
  1232.       ClientSocket := GetClientSocket(ClientWinSocket);
  1233.       if Assigned(FOnSocketEvent) then
  1234.         FOnSocketEvent(Self, ClientSocket, seAccept);
  1235.       if FServerType = stThreadBlocking then
  1236.       begin
  1237.         ClientSocket.ASyncStyles := [];
  1238.         GetServerThread(ClientSocket);
  1239.       end;
  1240.     end;
  1241.   finally
  1242.     Len := SizeOf(OldOpenType);
  1243.     setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, PChar(@OldOpenType), Len);
  1244.   end;
  1245. end;
  1246.  
  1247. procedure TServerWinSocket.Disconnect(Socket: TSocket);
  1248. var
  1249.   SaveCacheSize: Integer;
  1250. begin
  1251.   Lock;
  1252.   try
  1253.     SaveCacheSize := ThreadCacheSize;
  1254.     try
  1255.       ThreadCacheSize := 0;
  1256.       while FActiveThreads.Count > 0 do
  1257.         with TServerClientThread(FActiveThreads.Last) do
  1258.         begin
  1259.           FreeOnTerminate := False;
  1260.           Terminate;
  1261.           FEvent.SetEvent;
  1262.           if (ClientSocket <> nil) and ClientSocket.Connected then
  1263.             ClientSocket.Close;
  1264.           WaitFor;  
  1265.           Free;
  1266.         end;
  1267.       while FConnections.Count > 0 do
  1268.         TCustomWinSocket(FConnections.Last).Free;
  1269.       if FServerAcceptThread <> nil then
  1270.         FServerAcceptThread.Terminate;
  1271.       inherited Disconnect(Socket);
  1272.       FServerAcceptThread.Free;
  1273.       FServerAcceptThread := nil;
  1274.     finally
  1275.       ThreadCacheSize := SaveCacheSize;
  1276.     end;
  1277.   finally
  1278.     Unlock;
  1279.   end;
  1280. end;
  1281.  
  1282. function TServerWinSocket.DoCreateThread(ClientSocket: TServerClientWinSocket): TServerClientThread;
  1283. begin
  1284.   Result := TServerClientThread.Create(False, ClientSocket);
  1285. end;
  1286.  
  1287. procedure TServerWinSocket.Listen(var Name, Address, Service: string; Port: Word;
  1288.   QueueSize: Integer);
  1289. begin
  1290.   inherited Listen(Name, Address, Service, Port, QueueSize);
  1291.   if FConnected and (ServerType = stThreadBlocking) then
  1292.     FServerAcceptThread := TServerAcceptThread.Create(False, Self);
  1293. end;
  1294.  
  1295. procedure TServerWinSocket.SetServerType(Value: TServerType);
  1296. begin
  1297.   if Value <> FServerType then
  1298.     if not FConnected then
  1299.     begin
  1300.       FServerType := Value;
  1301.       if FServerType = stThreadBlocking then
  1302.         ASyncStyles := []
  1303.       else ASyncStyles := [asAccept];
  1304.     end else raise ESocketError.Create(sCantChangeWhileActive);
  1305. end;
  1306.  
  1307. procedure TServerWinSocket.SetThreadCacheSize(Value: Integer);
  1308. var
  1309.   Start, I: Integer;
  1310. begin
  1311.   if Value <> FThreadCacheSize then
  1312.   begin
  1313.     if Value < FThreadCacheSize then
  1314.       Start := Value
  1315.     else Start := FThreadCacheSize;
  1316.     FThreadCacheSize := Value;
  1317.     FListLock.Enter;
  1318.     try
  1319.       for I := 0 to FActiveThreads.Count - 1 do
  1320.         with TServerClientThread(FActiveThreads[I]) do
  1321.           KeepInCache := I < Start;
  1322.     finally
  1323.       FListLock.Leave;
  1324.     end;
  1325.   end;
  1326. end;
  1327.  
  1328. function TServerWinSocket.GetClientSocket(Socket: TSocket): TServerClientWinSocket;
  1329. begin
  1330.   Result := nil;
  1331.   if Assigned(FOnGetSocket) then FOnGetSocket(Self, Socket, Result);
  1332.   if Result = nil then
  1333.     Result := TServerClientWinSocket.Create(Socket, Self);
  1334. end;
  1335.  
  1336. procedure TServerWinSocket.ThreadEnd(AThread: TServerClientThread);
  1337. begin
  1338.   if Assigned(FOnThreadEnd) then FOnThreadEnd(Self, AThread);
  1339. end;
  1340.  
  1341. procedure TServerWinSocket.ThreadStart(AThread: TServerClientThread);
  1342. begin
  1343.   if Assigned(FOnThreadStart) then FOnThreadStart(Self, AThread);
  1344. end;
  1345.  
  1346. function TServerWinSocket.GetServerThread(ClientSocket: TServerClientWinSocket): TServerClientThread;
  1347. var
  1348.   I: Integer;
  1349. begin
  1350.   Result := nil;
  1351.   FListLock.Enter;
  1352.   try
  1353.     for I := 0 to FActiveThreads.Count - 1 do
  1354.       if TServerClientThread(FActiveThreads[I]).ClientSocket = nil then
  1355.       begin
  1356.         Result := FActiveThreads[I];
  1357.         Result.ReActivate(ClientSocket);
  1358.         Break;
  1359.       end;
  1360.   finally
  1361.     FListLock.Leave;
  1362.   end;
  1363.   if Result = nil then
  1364.   begin
  1365.     if Assigned(FOnGetThread) then FOnGetThread(Self, ClientSocket, Result);
  1366.     if Result = nil then Result := DoCreateThread(ClientSocket);
  1367.   end;
  1368. end;
  1369.  
  1370. function TServerWinSocket.GetClientThread(ClientSocket: TServerClientWinSocket): TServerClientThread;
  1371. var
  1372.   I: Integer;
  1373. begin
  1374.   Result := nil;
  1375.   FListLock.Enter;
  1376.   try
  1377.     for I := 0 to FActiveThreads.Count - 1 do
  1378.       if TServerClientThread(FActiveThreads[I]).ClientSocket = ClientSocket then
  1379.       begin
  1380.         Result := FActiveThreads[I];
  1381.         Break;
  1382.       end;
  1383.   finally
  1384.     FListLock.Leave;
  1385.   end;
  1386. end;
  1387.  
  1388. procedure TServerWinSocket.ClientConnect(Socket: TCustomWinSocket);
  1389. begin
  1390.   if Assigned(FOnClientConnect) then FOnClientConnect(Self, Socket);
  1391. end;
  1392.  
  1393. procedure TServerWinSocket.ClientDisconnect(Socket: TCustomWinSocket);
  1394. begin
  1395.   if Assigned(FOnClientDisconnect) then FOnClientDisconnect(Self, Socket);
  1396.   if ServerType = stNonBlocking then Socket.DeferFree;
  1397. end;
  1398.  
  1399. procedure TServerWinSocket.ClientRead(Socket: TCustomWinSocket);
  1400. begin
  1401.   if Assigned(FOnClientRead) then FOnClientRead(Self, Socket);
  1402. end;
  1403.  
  1404. procedure TServerWinSocket.ClientWrite(Socket: TCustomWinSocket);
  1405. begin
  1406.   if Assigned(FOnClientWrite) then FOnClientWrite(Self, Socket);
  1407. end;
  1408.  
  1409. procedure TServerWinSocket.ClientErrorEvent(Socket: TCustomWinSocket;
  1410.   ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  1411. begin
  1412.   if Assigned(FOnClientError) then FOnClientError(Self, Socket, ErrorEvent, ErrorCode);
  1413. end;
  1414.  
  1415. { TServerAcceptThread }
  1416.  
  1417. constructor TServerAcceptThread.Create(CreateSuspended: Boolean;
  1418.   ASocket: TServerWinSocket);
  1419. begin
  1420.   FServerSocket := ASocket;
  1421.   inherited Create(CreateSuspended);
  1422. end;
  1423.  
  1424. procedure TServerAcceptThread.Execute;
  1425. begin
  1426.   while not Terminated do
  1427.     FServerSocket.Accept(FServerSocket.SocketHandle);
  1428. end;
  1429.  
  1430. { TServerClientThread }
  1431.  
  1432. constructor TServerClientThread.Create(CreateSuspended: Boolean;
  1433.   ASocket: TServerClientWinSocket);
  1434. begin
  1435.   FreeOnTerminate := True;
  1436.   FEvent := TSimpleEvent.Create;
  1437.   inherited Create(True);
  1438.   Priority := tpHigher;
  1439.   ReActivate(ASocket);
  1440.   if not CreateSuspended then Resume;
  1441. end;
  1442.  
  1443. destructor TServerClientThread.Destroy;
  1444. begin
  1445.   FClientSocket.Free;
  1446.   FEvent.Free;
  1447.   inherited Destroy;
  1448. end;
  1449.  
  1450. procedure TServerClientThread.ReActivate(ASocket: TServerClientWinSocket);
  1451. begin
  1452.   FClientSocket := ASocket;
  1453.   if Assigned(FClientSocket) then
  1454.   begin
  1455.     FServerSocket := FClientSocket.ServerWinSocket;
  1456.     FServerSocket.AddThread(Self);
  1457.     FClientSocket.OnSocketEvent := HandleEvent;
  1458.     FClientSocket.OnErrorEvent := HandleError;
  1459.     FEvent.SetEvent;
  1460.   end;
  1461. end;
  1462.  
  1463. procedure TServerClientThread.DoHandleException;
  1464. begin
  1465.   if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
  1466.   if FException is Exception then
  1467.   begin
  1468.     Application.ShowException(FException);
  1469.   end else
  1470.     SysUtils.ShowException(FException, nil);
  1471. end;
  1472.  
  1473. procedure TServerClientThread.DoRead;
  1474. begin
  1475.   ClientSocket.ServerWinSocket.Event(ClientSocket, seRead);
  1476. end;
  1477.  
  1478. procedure TServerClientThread.DoTerminate;
  1479. begin
  1480.   if Assigned(FServerSocket) then
  1481.     FServerSocket.RemoveThread(Self);
  1482. end;
  1483.  
  1484. procedure TServerClientThread.DoWrite;
  1485. begin
  1486.   FServerSocket.Event(ClientSocket, seWrite);
  1487. end;
  1488.  
  1489. procedure TServerClientThread.HandleEvent(Sender: TObject; Socket: TCustomWinSocket;
  1490.   SocketEvent: TSocketEvent);
  1491. begin
  1492.   Event(SocketEvent);
  1493. end;
  1494.  
  1495. procedure TServerClientThread.HandleError(Sender: TObject; Socket: TCustomWinSocket;
  1496.   ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  1497. begin
  1498.   Error(ErrorEvent, ErrorCode);
  1499. end;
  1500.  
  1501. procedure TServerClientThread.Event(SocketEvent: TSocketEvent);
  1502. begin
  1503.   FServerSocket.ClientEvent(Self, ClientSocket, SocketEvent);
  1504. end;
  1505.  
  1506. procedure TServerClientThread.Error(ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  1507. begin
  1508.   FServerSocket.ClientError(Self, ClientSocket, ErrorEvent, ErrorCode);
  1509. end;
  1510.  
  1511. procedure TServerClientThread.HandleException;
  1512. begin
  1513.   FException := Exception(ExceptObject);
  1514.   try
  1515.     if not (FException is EAbort) then
  1516.       Synchronize(DoHandleException);
  1517.   finally
  1518.     FException := nil;
  1519.   end;
  1520. end;
  1521.  
  1522. procedure TServerClientThread.Execute;
  1523. begin
  1524.   FServerSocket.ThreadStart(Self);
  1525.   try
  1526.     try
  1527.       while True do
  1528.       begin
  1529.         if StartConnect then ClientExecute;
  1530.         if EndConnect then Break;
  1531.       end;
  1532.     except
  1533.       HandleException;
  1534.       KeepInCache := False;
  1535.     end;
  1536.   finally
  1537.     FServerSocket.ThreadEnd(Self);
  1538.   end;
  1539. end;
  1540.  
  1541. procedure TServerClientThread.ClientExecute;
  1542. var
  1543.   FDSet: TFDSet;
  1544.   TimeVal: TTimeVal;
  1545. begin
  1546.   while not Terminated and ClientSocket.Connected do
  1547.   begin
  1548.     FD_ZERO(FDSet);
  1549.     FD_SET(ClientSocket.SocketHandle, FDSet);
  1550.     TimeVal.tv_sec := 0;
  1551.     TimeVal.tv_usec := 500;
  1552.     if (select(0, @FDSet, nil, nil, @TimeVal) > 0) and not Terminated then
  1553.       if ClientSocket.ReceiveBuf(FDSet, -1) = 0 then Break
  1554.       else Synchronize(DoRead);
  1555.     if (select(0, nil, @FDSet, nil, @TimeVal) > 0) and not Terminated then
  1556.       Synchronize(DoWrite);
  1557.   end;
  1558. end;
  1559.  
  1560. function TServerClientThread.StartConnect: Boolean;
  1561. begin
  1562.   if FEvent.WaitFor(INFINITE) = wrSignaled then
  1563.     FEvent.ResetEvent;
  1564.   Result := not Terminated;
  1565. end;
  1566.  
  1567. function TServerClientThread.EndConnect: Boolean;
  1568. begin
  1569.   FClientSocket.Free;
  1570.   FClientSocket := nil;
  1571.   Result := Terminated or not KeepInCache;
  1572. end;
  1573.  
  1574. { TCustomSocket }
  1575.  
  1576. procedure TCustomSocket.DoEvent(Sender: TObject; Socket: TCustomWinSocket;
  1577.   SocketEvent: TSocketEvent);
  1578. begin
  1579.   Event(Socket, SocketEvent);
  1580. end;
  1581.  
  1582. procedure TCustomSocket.DoError(Sender: TObject; Socket: TCustomWinSocket;
  1583.   ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  1584. begin
  1585.   Error(Socket, ErrorEvent, ErrorCode);
  1586. end;
  1587.  
  1588. procedure TCustomSocket.Event(Socket: TCustomWinSocket; SocketEvent: TSocketEvent);
  1589. begin
  1590.   case SocketEvent of
  1591.     seLookup: if Assigned(FOnLookup) then FOnLookup(Self, Socket);
  1592.     seConnecting: if Assigned(FOnConnecting) then FOnConnecting(Self, Socket);
  1593.     seConnect:
  1594.       begin
  1595.         FActive := True;
  1596.         if Assigned(FOnConnect) then FOnConnect(Self, Socket);
  1597.       end;
  1598.     seListen:
  1599.       begin
  1600.         FActive := True;
  1601.         if Assigned(FOnListen) then FOnListen(Self, Socket);
  1602.       end;
  1603.     seDisconnect:
  1604.       begin
  1605.         FActive := False;
  1606.         if Assigned(FOnDisconnect) then FOnDisconnect(Self, Socket);
  1607.       end;
  1608.     seAccept: if Assigned(FOnAccept) then FOnAccept(Self, Socket);
  1609.     seRead: if Assigned(FOnRead) then FOnRead(Self, Socket);
  1610.     seWrite: if Assigned(FOnWrite) then FOnWrite(Self, Socket);
  1611.   end;
  1612. end;
  1613.  
  1614. procedure TCustomSocket.Error(Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  1615.   var ErrorCode: Integer);
  1616. begin
  1617.   if Assigned(FOnError) then FOnError(Self, Socket, ErrorEvent, ErrorCode);
  1618. end;
  1619.  
  1620. procedure TCustomSocket.SetActive(Value: Boolean);
  1621. begin
  1622.   if Value <> FActive then
  1623.   begin
  1624.     if (csDesigning in ComponentState) or (csLoading in ComponentState) then
  1625.       FActive := Value;
  1626.     if not (csLoading in ComponentState) then
  1627.       DoActivate(Value);
  1628.   end;
  1629. end;
  1630.  
  1631. procedure TCustomSocket.Loaded;
  1632. begin
  1633.   inherited Loaded;
  1634.   DoActivate(FActive);
  1635. end;
  1636.  
  1637. procedure TCustomSocket.SetAddress(Value: string);
  1638. begin
  1639.   if CompareText(Value, FAddress) <> 0 then
  1640.   begin
  1641.     if not (csLoading in ComponentState) and FActive then
  1642.       raise ESocketError.Create(sCantChangeWhileActive);
  1643.     FAddress := Value;
  1644.   end;
  1645. end;
  1646.  
  1647. procedure TCustomSocket.SetHost(Value: string);
  1648. begin
  1649.   if CompareText(Value, FHost) <> 0 then
  1650.   begin
  1651.     if not (csLoading in ComponentState) and FActive then
  1652.       raise ESocketError.Create(sCantChangeWhileActive);
  1653.     FHost := Value;
  1654.   end;
  1655. end;
  1656.  
  1657. procedure TCustomSocket.SetPort(Value: Integer);
  1658. begin
  1659.   if FPort <> Value then
  1660.   begin
  1661.     if not (csLoading in ComponentState) and FActive then
  1662.       raise ESocketError.Create(sCantChangeWhileActive);
  1663.     FPort := Value;
  1664.   end;
  1665. end;
  1666.  
  1667. procedure TCustomSocket.SetService(Value: string);
  1668. begin
  1669.   if CompareText(Value, FService) <> 0 then
  1670.   begin
  1671.     if not (csLoading in ComponentState) and FActive then
  1672.       raise ESocketError.Create(sCantChangeWhileActive);
  1673.     FService := Value;
  1674.   end;
  1675. end;
  1676.  
  1677. procedure TCustomSocket.Open;
  1678. begin
  1679.   Active := True;
  1680. end;
  1681.  
  1682. procedure TCustomSocket.Close;
  1683. begin
  1684.   Active := False;
  1685. end;
  1686.  
  1687. { TWinSocketStream }
  1688.  
  1689. constructor TWinSocketStream.Create(ASocket: TCustomWinSocket; TimeOut: Longint);
  1690. begin
  1691.   if ASocket.ASyncStyles <> [] then
  1692.     raise ESocketError.Create(sSocketMustBeBlocking);
  1693.   FSocket := ASocket;
  1694.   FTimeOut := TimeOut;
  1695.   FEvent := TSimpleEvent.Create;
  1696.   inherited Create;
  1697. end;
  1698.  
  1699. destructor TWinSocketStream.Destroy;
  1700. begin
  1701.   FEvent.Free;
  1702.   inherited Destroy;
  1703. end;
  1704.  
  1705. function TWinSocketStream.WaitForData(Timeout: Longint): Boolean;
  1706. var
  1707.   FDSet: TFDSet;
  1708.   TimeVal: TTimeVal;
  1709. begin
  1710.   TimeVal.tv_sec := Timeout div 1000;
  1711.   TimeVal.tv_usec := (Timeout mod 1000) * 1000;
  1712.   FD_ZERO(FDSet);
  1713.   FD_SET(FSocket.SocketHandle, FDSet);
  1714.   Result := select(0, @FDSet, nil, nil, @TimeVal) > 0;
  1715. end;
  1716.  
  1717. function TWinSocketStream.Read(var Buffer; Count: Longint): Longint;
  1718. var
  1719.   Overlapped: TOverlapped;
  1720.   ErrorCode: Integer;
  1721. begin
  1722.   FSocket.Lock;
  1723.   try
  1724.     FillChar(OVerlapped, SizeOf(Overlapped), 0);
  1725.     Overlapped.hEvent := FEvent.Handle;
  1726.     if not ReadFile(FSocket.SocketHandle, Buffer, Count, Integer(Result),
  1727.       @Overlapped) and (GetLastError <> ERROR_IO_PENDING) then
  1728.     begin
  1729.       ErrorCode := GetLastError;
  1730.       raise ESocketError.CreateFmt(sSocketIOError, [sSocketRead, ErrorCode,
  1731.         SysErrorMessage(ErrorCode)]);
  1732.     end;
  1733.     if FEvent.WaitFor(FTimeOut) <> wrSignaled then
  1734.       Result := 0
  1735.     else
  1736.     begin
  1737.       GetOverlappedResult(FSocket.SocketHandle, Overlapped, Integer(Result), False);
  1738.       FEvent.ResetEvent;
  1739.     end;
  1740.   finally
  1741.     FSocket.Unlock;
  1742.   end;
  1743. end;
  1744.  
  1745. function TWinSocketStream.Write(const Buffer; Count: Longint): Longint;
  1746. var
  1747.   Overlapped: TOverlapped;
  1748.   ErrorCode: Integer;
  1749. begin
  1750.   FSocket.Lock;
  1751.   try
  1752.     FillChar(OVerlapped, SizeOf(Overlapped), 0);
  1753.     Overlapped.hEvent := FEvent.Handle;
  1754.     if not WriteFile(FSocket.SocketHandle, Buffer, Count, Integer(Result),
  1755.       @Overlapped) and (GetLastError <> ERROR_IO_PENDING) then
  1756.     begin
  1757.       ErrorCode := GetLastError;
  1758.       raise ESocketError.CreateFmt(sSocketIOError, [sSocketWrite, ErrorCode,
  1759.         SysErrorMessage(ErrorCode)]);
  1760.     end;    
  1761.     if FEvent.WaitFor(FTimeOut) <> wrSignaled then
  1762.       Result := 0
  1763.     else GetOverlappedResult(FSocket.SocketHandle, Overlapped, Integer(Result), False);
  1764.   finally
  1765.     FSocket.Unlock;
  1766.   end;
  1767. end;
  1768.  
  1769. function TWinSocketStream.Seek(Offset: Longint; Origin: Word): Longint;
  1770. begin
  1771.   Result := 0;
  1772. end;
  1773.  
  1774. { TClientSocket }
  1775.  
  1776. constructor TClientSocket.Create(AOwner: TComponent);
  1777. begin
  1778.   inherited Create(AOwner);
  1779.   FClientSocket := TClientWinSocket.Create(INVALID_SOCKET);
  1780.   FClientSocket.OnSocketEvent := DoEvent;
  1781.   FClientSocket.OnErrorEvent := DoError;
  1782. end;
  1783.  
  1784. destructor TClientSocket.Destroy;
  1785. begin
  1786.   FClientSocket.Free;
  1787.   inherited Destroy;
  1788. end;
  1789.  
  1790. procedure TClientSocket.DoActivate(Value: Boolean);
  1791. begin
  1792.   if (Value <> FClientSocket.Connected) and not (csDesigning in ComponentState) then
  1793.   begin
  1794.     if FClientSocket.Connected then
  1795.       FClientSocket.Disconnect(FClientSocket.FSocket)
  1796.     else FClientSocket.Open(FHost, FAddress, FService, FPort);
  1797.   end;
  1798. end;
  1799.  
  1800. function TClientSocket.GetClientType: TClientType;
  1801. begin
  1802.   Result := FClientSocket.ClientType;
  1803. end;
  1804.  
  1805. procedure TClientSocket.SetClientType(Value: TClientType);
  1806. begin
  1807.   FClientSocket.ClientType := Value;
  1808. end;
  1809.  
  1810. { TCustomServerSocket }
  1811.  
  1812. destructor TCustomServerSocket.Destroy;
  1813. begin
  1814.   FServerSocket.Free;
  1815.   inherited Destroy;
  1816. end;
  1817.  
  1818. procedure TCustomServerSocket.DoActivate(Value: Boolean);
  1819. begin
  1820.   if (Value <> FServerSocket.Connected) and not (csDesigning in ComponentState) then
  1821.   begin
  1822.     if FServerSocket.Connected then
  1823.       FServerSocket.Disconnect(FServerSocket.SocketHandle)
  1824.     else FServerSocket.Listen(FHost, FAddress, FService, FPort, 5);
  1825.   end;
  1826. end;
  1827.  
  1828. function TCustomServerSocket.GetServerType: TServerType;
  1829. begin
  1830.   Result := FServerSocket.ServerType;
  1831. end;
  1832.  
  1833. procedure TCustomServerSocket.SetServerType(Value: TServerType);
  1834. begin
  1835.   FServerSocket.ServerType := Value;
  1836. end;
  1837.  
  1838. function TCustomServerSocket.GetGetThreadEvent: TGetThreadEvent;
  1839. begin
  1840.   Result := FServerSocket.OnGetThread;
  1841. end;
  1842.  
  1843. procedure TCustomServerSocket.SetGetThreadEvent(Value: TGetThreadEvent);
  1844. begin
  1845.   FServerSocket.OnGetThread := Value;
  1846. end;
  1847.  
  1848. function TCustomServerSocket.GetGetSocketEvent: TGetSocketEvent;
  1849. begin
  1850.   Result := FServerSocket.OnGetSocket;
  1851. end;
  1852.  
  1853. procedure TCustomServerSocket.SetGetSocketEvent(Value: TGetSocketEvent);
  1854. begin
  1855.   FServerSocket.OnGetSocket := Value;
  1856. end;
  1857.  
  1858. function TCustomServerSocket.GetThreadCacheSize: Integer;
  1859. begin
  1860.   Result := FServerSocket.ThreadCacheSize;
  1861. end;
  1862.  
  1863. procedure TCustomServerSocket.SetThreadCacheSize(Value: Integer);
  1864. begin
  1865.   FServerSocket.ThreadCacheSize := Value;
  1866. end;
  1867.  
  1868. function TCustomServerSocket.GetOnThreadStart: TThreadNotifyEvent;
  1869. begin
  1870.   Result := FServerSocket.OnThreadStart;
  1871. end;
  1872.  
  1873. function TCustomServerSocket.GetOnThreadEnd: TThreadNotifyEvent;
  1874. begin
  1875.   Result := FServerSocket.OnThreadEnd;
  1876. end;
  1877.  
  1878. procedure TCustomServerSocket.SetOnThreadStart(Value: TThreadNotifyEvent);
  1879. begin
  1880.   FServerSocket.OnThreadStart := Value;
  1881. end;
  1882.  
  1883. procedure TCustomServerSocket.SetOnThreadEnd(Value: TThreadNotifyEvent);
  1884. begin
  1885.   FServerSocket.OnThreadEnd := Value;
  1886. end;
  1887.  
  1888. function TCustomServerSocket.GetOnClientEvent(Index: Integer): TSocketNotifyEvent;
  1889. begin
  1890.   case Index of
  1891.     0: Result := FServerSocket.OnClientRead;
  1892.     1: Result := FServerSocket.OnClientWrite;
  1893.     2: Result := FServerSocket.OnClientConnect;
  1894.     3: Result := FServerSocket.OnClientDisconnect;
  1895.   end;
  1896. end;
  1897.  
  1898. procedure TCustomServerSocket.SetOnClientEvent(Index: Integer;
  1899.   Value: TSocketNotifyEvent);
  1900. begin
  1901.   case Index of
  1902.     0: FServerSocket.OnClientRead := Value;
  1903.     1: FServerSocket.OnClientWrite := Value;
  1904.     2: FServerSocket.OnClientConnect := Value;
  1905.     3: FServerSocket.OnClientDisconnect := Value;
  1906.   end;
  1907. end;
  1908.  
  1909. function TCustomServerSocket.GetOnClientError: TSocketErrorEvent;
  1910. begin
  1911.   Result := FServerSocket.OnClientError;
  1912. end;
  1913.  
  1914. procedure TCustomServerSocket.SetOnClientError(Value: TSocketErrorEvent);
  1915. begin
  1916.   FServerSocket.OnClientError := Value;
  1917. end;
  1918.  
  1919. { TServerSocket }
  1920.  
  1921. constructor TServerSocket.Create(AOwner: TComponent);
  1922. begin
  1923.   inherited Create(AOwner);
  1924.   FServerSocket := TServerWinSocket.Create(INVALID_SOCKET);
  1925.   FServerSocket.OnSocketEvent := DoEvent;
  1926.   FServerSocket.OnErrorEvent := DoError;
  1927.   FServerSocket.ThreadCacheSize := 10;
  1928. end;
  1929.  
  1930. end.
  1931.  
  1932.