home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sibdemo3.zip / SOURCE.DAT / SOURCE / ADDON / SCKTCOMP.PAS < prev    next >
Pascal/Delphi Source File  |  1998-05-04  |  83KB  |  2,385 lines
  1.  
  2. {╔══════════════════════════════════════════════════════════════════════════╗
  3.  ║                                                                          ║
  4.  ║     Sibyl Portable Component Classes                                     ║
  5.  ║                                                                          ║
  6.  ║     Delphi 3 compatible sockets                                          ║                           ║
  7.  ║     Copyright (C) 1995,97 SpeedSoft Germany,   All rights reserved.      ║
  8.  ║     Portions Copyright (C) 1997 Borland Inc.                             ║
  9.  ║                                                                          ║
  10.  ╚══════════════════════════════════════════════════════════════════════════╝}
  11.  
  12. Unit ScktComp;
  13.  
  14. Interface
  15.  
  16. Uses SysUtils,Classes,Forms,SyncComp;
  17.  
  18. {$IFDEF OS2}
  19. Uses Os2Def,BseDos,BseErr,PmWin;
  20. {$ENDIF}
  21. {$IFDEF WIN32}
  22. Uses WinNT,WinBase,WinUser;
  23. {$ENDIF}
  24.  
  25. Const
  26.   CM_SOCKETMESSAGE = WM_USER + $0005;
  27.   CM_DEFERFREE = WM_USER + $0006;
  28.  
  29.   {$IFDEF OS2}
  30.   INFINITE=SEM_INDEFINITE_WAIT;
  31.   {$ENDIF}
  32.   {$IFDEF WIN32}
  33.   INFINITE=WinBase.INFINITE;
  34.   {$ENDIF}
  35.  
  36. Type
  37.   ESocketError = class(Exception);
  38.  
  39.   TSocket=LongInt;
  40.  
  41.   TIn_Addr=Record
  42.                  Case Integer Of
  43.                    1:(S_un_b:Record s_b1,s_b2,s_b3,s_b4:Byte; End;);
  44.                    2:(s_un_w:Record s_w1,s_w2:Word; End;);
  45.                    3:(s_addr:LongWord);
  46.   End;
  47.  
  48.   TSockAddrIn=Record
  49.                     sin_family:Integer;
  50.                     sin_port:Word;
  51.                     sin_addr:TIn_addr;
  52.                     sin_zero:CString[7];;
  53.   End;
  54.   TInAddr=TIn_Addr;
  55.  
  56.   TServerWinSocket=Class;
  57.   TServerClientWinSocket=Class;
  58.   TCustomWinSocket=Class;
  59.   TCustomSocket=Class;
  60.   TServerAcceptThread=Class;
  61.   TServerClientThread=Class;
  62.  
  63.   {$M+}
  64.   TClientType = (ctNonBlocking, ctBlocking);
  65.   TServerType = (stNonBlocking, stThreadBlocking);
  66.  
  67.   TSocketEvent=(seLookup, seConnecting, seConnect, seDisconnect, seListen,
  68.                 seAccept, seWrite, seRead, seDisconnected);
  69.   TErrorEvent = (eeGeneral, eeSend, eeReceive, eeConnect, eeDisconnect, eeAccept);
  70.  
  71.   TGetSocketEvent = Procedure(Sender: TObject; Socket: TSocket;
  72.                               Var ClientSocket: TServerClientWinSocket) of object;
  73.   TGetThreadEvent = Procedure(Sender: TObject; ClientSocket: TServerClientWinSocket;
  74.                               Var SocketThread: TServerClientThread) of object;
  75.  
  76.   TSocketEventEvent = Procedure(Sender: TObject; Socket: TCustomWinSocket;
  77.                                 SocketEvent: TSocketEvent) Of Object;
  78.   TSocketErrorEvent = Procedure(Sender: TObject; Socket: TCustomWinSocket;
  79.                                 ErrorEvent: TErrorEvent; Var ErrorCode:Word) Of Object;
  80.  
  81.   TSocketNotifyEvent = Procedure(Sender: TObject; Socket: TCustomWinSocket) Of Object;
  82.  
  83.   TThreadNotifyEvent = Procedure(Sender:TObject;Thread: TServerClientThread) Of Object;
  84.  
  85.   TAsyncStyle=(asRead,asWrite,asOOB,asAccept,asConnect,asClose);
  86.   TAsyncStyles=Set Of TAsyncStyle;
  87.   {$M-}
  88.  
  89.   TCustomWinSocket=Class
  90.     Private
  91.        FConnected: Boolean;
  92.        FSendStream: TStream;
  93.        FSocket: TSocket;
  94.        FDropAfterSend: Boolean;
  95.        FHandle:LongWord;
  96.        FOnSocketEvent: TSocketEventEvent;
  97.        FOnErrorEvent: TSocketErrorEvent;
  98.        FData: Pointer;
  99.        FSocketControl:TControl;
  100.        FAddr: TSockAddrIn;
  101.        FAsyncStyles: TASyncStyles;
  102.     Private
  103.        Function GetHandle:LongWord;
  104.        Function GetLocalHost:String;
  105.        Function GetLocalAddress:String;
  106.        Function GetLocalPort:LongInt;
  107.        Function GetRemoteHost:String;
  108.        Function GetRemoteAddress:String;
  109.        Function GetRemotePort:LongInt;
  110.        Function GetRemoteAddr:TSockAddrIn;
  111.     Protected
  112.        Procedure Open(Var Name,Address,Service:String;Port:Word);
  113.        Procedure Read(Socket:TSocket); Virtual;
  114.        Procedure Write(Socket:TSocket); Virtual;
  115.        Procedure Connect(Socket:TSocket); Virtual;
  116.        Procedure Disconnect(Socket:TSocket); Virtual;
  117.        Function InitSocket(Var Name,Address,Service:String;Port:Word;
  118.                            Client:Boolean):TSockAddrIn;
  119.        Procedure Event(Socket:TCustomWinSocket;SocketEvent:TSocketEvent); Virtual;
  120.        Procedure Error(Socket:TCustomWinSocket;ErrorEvent:TErrorEvent;Var ErrorCode:Word); Virtual;
  121.        Procedure SetAsyncStyles(Value:TASyncStyles);
  122.        Procedure Listen(Var Name,Address,Service:String;Port:Word;QueueSize:LongInt);
  123.        Procedure Accept(Socket:TSocket); Virtual;
  124.     Public
  125.        Constructor Create(ASocket:TSocket);
  126.        Destructor Destroy; Override;
  127.        Function ReceiveBuf(Var Buf;Count:LongInt):LongInt;
  128.        Function ReceiveText: String;
  129.        Function SendBuf(Var Buf; Count: LongInt): LongInt;
  130.        Function SendStream(AStream: TStream): Boolean;
  131.        Procedure Close;
  132.        Function LookupName(Const Name:String):TInAddr;
  133.        Function LookupService(Const Service:String):LongInt;
  134.        Function ReceiveLength:LongInt;
  135.        Function SendStreamThenDrop(AStream:TStream): Boolean;
  136.        Procedure SendText(Const S:String);
  137.     Public
  138.        Property LocalHost:String read GetLocalHost;
  139.        Property LocalAddress:String read GetLocalAddress;
  140.        Property LocalPort:LongInt read GetLocalPort;
  141.        Property RemoteHost:String read GetRemoteHost;
  142.        Property RemoteAddress:String read GetRemoteAddress;
  143.        Property RemotePort:LongInt read GetRemotePort;
  144.        Property RemoteAddr:TSockAddrIn read GetRemoteAddr;
  145.        Property Connected:Boolean read FConnected;
  146.        Property Addr:TSockAddrIn read FAddr;
  147.        Property ASyncStyles:TAsyncStyles read FAsyncStyles write SetAsyncStyles;
  148.        Property Handle:LongWord read GetHandle;
  149.        Property SocketHandle:TSocket read FSocket;
  150.        Property OnSocketEvent:TSocketEventEvent read FOnSocketEvent write FOnSocketEvent;
  151.        Property OnErrorEvent:TSocketErrorEvent read FOnErrorEvent write FOnErrorEvent;
  152.        Property Data:Pointer read FData write FData;
  153.   End;
  154.  
  155.   TClientWinSocket=Class(TCustomWinSocket)
  156.     Private
  157.        FClientType:TClientType;
  158.     Protected
  159.        Procedure Connect(Socket:TSocket); Override;
  160.        Procedure SetClientType(Value:TClientType);
  161.     Public
  162.        Property ClientType:TClientType read FClientType write SetClientType;
  163.   End;
  164.  
  165.   TServerClientWinSocket=Class(TCustomWinSocket)
  166.     Private
  167.        FServerWinSocket: TServerWinSocket;
  168.     Public
  169.        Constructor Create(Socket:TSocket;ServerWinSocket:TServerWinSocket);
  170.        Destructor Destroy; Override;
  171.     Public
  172.        Property ServerWinSocket:TServerWinSocket read FServerWinSocket;
  173.   End;
  174.  
  175.   TServerWinSocket=Class(TCustomWinSocket)
  176.     Private
  177.        FConnections: TList;
  178.        FActiveThreads: TList;
  179.        FServerType: TServerType;
  180.        FThreadCacheSize: LongInt;
  181.        FServerAcceptThread: TServerAcceptThread;
  182.        FOnGetSocket: TGetSocketEvent;
  183.        FOnGetThread: TGetThreadEvent;
  184.        FOnThreadStart: TThreadNotifyEvent;
  185.        FOnThreadEnd: TThreadNotifyEvent;
  186.        FOnClientConnect: TSocketNotifyEvent;
  187.        FOnClientDisconnect: TSocketNotifyEvent;
  188.        FOnClientDisconnected: TSocketNotifyEvent;
  189.        FOnClientRead: TSocketNotifyEvent;
  190.        FOnClientWrite: TSocketNotifyEvent;
  191.        FOnClientError: TSocketErrorEvent;
  192.     Private
  193.        Procedure ClientEvent(Sender:TObject;Socket:TCustomWinSocket;SocketEvent: TSocketEvent);
  194.        Procedure ClientError(Sender:TObject;Socket:TCustomWinSocket;
  195.                              ErrorEvent:TErrorEvent;Var ErrorCode:Word);
  196.        Function GetActiveConnections:LongInt;
  197.        Function GetActiveThreads:LongInt;
  198.        Function GetConnections(Index:LongInt):TCustomWinSocket;
  199.        Function GetIdleThreads:LongInt;
  200.     Protected
  201.        Procedure Accept(Socket:TSocket); Override;
  202.        Procedure ClientConnect(Socket:TCustomWinSocket); Virtual;
  203.        Procedure ClientDisconnect(Socket:TCustomWinSocket); Virtual;
  204.        Procedure ClientDisconnected(Socket:TCustomWinSocket); Virtual;
  205.        Procedure ClientErrorEvent(Socket:TCustomWinSocket; ErrorEvent: TErrorEvent;
  206.                                   Var ErrorCode:Word); Virtual;
  207.        Procedure Disconnect(Socket:TSocket); Override;
  208.        Procedure ClientRead(Socket:TCustomWinSocket); Virtual;
  209.        Procedure ClientWrite(Socket:TCustomWinSocket); Virtual;
  210.        Function DoCreateThread(ClientSocket:TServerClientWinSocket): TServerClientThread; Virtual;
  211.        Procedure Listen(Var Name,Address,Service:String;Port:Word;QueueSize:LongInt);
  212.        Procedure SetServerType(Value:TServerType);
  213.        Procedure SetThreadCacheSize(Value:LongInt);
  214.        Procedure ThreadEnd(AThread:TServerClientThread); Virtual;
  215.        Procedure ThreadStart(AThread:TServerClientThread); Virtual;
  216.        Function GetClientSocket(Socket:TSocket): TServerClientWinSocket; Virtual;
  217.        Function GetServerThread(ClientSocket:TServerClientWinSocket): TServerClientThread; Virtual;
  218.     Public
  219.        Constructor Create(ASocket:TSocket);
  220.        Destructor Destroy; Override;
  221.        Function GetClientThread(ClientSocket:TServerClientWinSocket): TServerClientThread;
  222.     Public
  223.        Property ActiveConnections:LongInt read GetActiveConnections;
  224.        Property ActiveThreads:LongInt read GetActiveThreads;
  225.        Property Connections[Index: LongInt]: TCustomWinSocket read GetConnections;
  226.        Property IdleThreads:LongInt read GetIdleThreads;
  227.        Property ServerType:TServerType read FServerType write SetServerType;
  228.        Property ThreadCacheSize: LongInt read FThreadCacheSize write SetThreadCacheSize;
  229.        Property OnGetSocket:TGetSocketEvent read FOnGetSocket write FOnGetSocket;
  230.        Property OnGetThread:TGetThreadEvent read FOnGetThread write FOnGetThread;
  231.        Property OnThreadStart:TThreadNotifyEvent read FOnThreadStart write FOnThreadStart;
  232.        Property OnThreadEnd:TThreadNotifyEvent read FOnThreadEnd write FOnThreadEnd;
  233.        Property OnClientConnect:TSocketNotifyEvent read FOnClientConnect write FOnClientConnect;
  234.        Property OnClientDisconnect:TSocketNotifyEvent read FOnClientDisconnect write FOnClientDisconnect;
  235.        Property OnClientDisconnected:TSocketNotifyEvent read FOnClientDisconnected write FOnClientDisconnected;
  236.        Property OnClientRead:TSocketNotifyEvent read FOnClientRead write FOnClientRead;
  237.        Property OnClientWrite:TSocketNotifyEvent read FOnClientWrite write FOnClientWrite;
  238.        Property OnClientError:TSocketErrorEvent read FOnClientError write FOnClientError;
  239.   End;
  240.  
  241.   TServerAcceptThread=Class(TThread)
  242.     Private
  243.        FServerSocket: TServerWinSocket;
  244.     Public
  245.        Constructor Create(CreateSuspended:Boolean;ASocket:TServerWinSocket);
  246.        Procedure Execute; Override;
  247.     Public
  248.        Property ServerSocket:TServerWinSocket read FServerSocket;
  249.   End;
  250.  
  251.   TServerClientThread = class(TThread)
  252.     Private
  253.        FKeepInCache: Boolean;
  254.        FData: Pointer;
  255.        FClientSocket: TServerClientWinSocket;
  256.        FServerSocket: TServerWinSocket;
  257.        FException: Exception;
  258.        FEvent: TSimpleEvent;
  259.     Private
  260.        Procedure HandleEvent(Sender:TObject;Socket:TCustomWinSocket;SocketEvent: TSocketEvent);
  261.        Procedure HandleError(Sender:TObject;Socket:TCustomWinSocket;
  262.                              ErrorEvent:TErrorEvent;Var ErrorCode:Word);
  263.        Procedure DoHandleException;
  264.        Procedure DoRead;
  265.        Procedure DoWrite;
  266.     Protected
  267.        Procedure DoTerminate; Override;
  268.        Procedure Execute; Override;
  269.        Procedure ClientExecute; virtual;
  270.        Procedure Event(SocketEvent:TSocketEvent); virtual;
  271.        Procedure Error(ErrorEvent:TErrorEvent; Var ErrorCode:Word); virtual;
  272.        Procedure HandleException(e:Exception); virtual;
  273.        Procedure ReActivate(ASocket:TServerClientWinSocket);
  274.        Function StartConnect:Boolean;
  275.        Function EndConnect:Boolean;
  276.     Public
  277.        Constructor Create(CreateSuspended:Boolean;ASocket:TServerClientWinSocket);
  278.        Destructor Destroy; Override;
  279.     Public
  280.        Property ClientSocket:TServerClientWinSocket read FClientSocket;
  281.        Property ServerSocket:TServerWinSocket read FServerSocket;
  282.        Property KeepInCache:Boolean read FKeepInCache write FKeepInCache;
  283.        Property Data:Pointer read FData write FData;
  284.   End;
  285.  
  286.   TCustomSocket=Class(TComponent)
  287.     Private
  288.        FActive:Boolean;
  289.        FPort:LongInt;
  290.        FAddress:String;
  291.        FHost:String;
  292.        FService:String;
  293.        FOnLookup:TSocketNotifyEvent;
  294.        FOnConnect:TSocketNotifyEvent;
  295.        FOnConnecting:TSocketNotifyEvent;
  296.        FOnDisconnect:TSocketNotifyEvent;
  297.        FOnListen:TSocketNotifyEvent;
  298.        FOnAccept:TSocketNotifyEvent;
  299.        FOnRead:TSocketNotifyEvent;
  300.        FOnWrite:TSocketNotifyEvent;
  301.        FOnError:TSocketErrorEvent;
  302.     Private
  303.        Procedure DoEvent(Sender:TObject;Socket:TCustomWinSocket;SocketEvent:TSocketEvent);
  304.        Procedure DoError(Sender:TObject;Socket:TCustomWinSocket;ErrorEvent:TErrorEvent;Var ErrorCode:Word);
  305.     Protected
  306.        Procedure Event(Socket:TCustomWinSocket;SocketEvent:TSocketEvent); Virtual;
  307.        Procedure Error(Socket:TCustomWinSocket;ErrorEvent:TErrorEvent;Var ErrorCode:Word); Virtual;
  308.        Procedure DoActivate(Value:Boolean); Virtual; Abstract;
  309.        Procedure Loaded; Override;
  310.        Procedure SetActive(Value:Boolean);
  311.        Procedure SetAddress(Value:String);
  312.        Procedure SetHost(Value:String);
  313.        Procedure SetPort(Value:LongInt);
  314.        Procedure SetService(Value:String);
  315.     Protected
  316.        Property Active:Boolean read FActive write SetActive;
  317.        Property Address:String read FAddress write SetAddress;
  318.        Property OnRead:TSocketNotifyEvent read FOnRead write FOnRead;
  319.        Property OnWrite:TSocketNotifyEvent read FOnWrite write FOnWrite;
  320.        Property Host:String read FHost write SetHost;
  321.        Property Port:LongInt read FPort write SetPort;
  322.        Property Service:String read FService write SetService;
  323.        Property OnLookup:TSocketNotifyEvent read FOnLookup write FOnLookup;
  324.        Property OnConnecting:TSocketNotifyEvent read FOnConnecting write FOnConnecting;
  325.        Property OnConnect:TSocketNotifyEvent read FOnConnect write FOnConnect;
  326.        Property OnDisconnect:TSocketNotifyEvent read FOnDisconnect write FOnDisconnect;
  327.        Property OnListen:TSocketNotifyEvent read FOnListen write FOnListen;
  328.        Property OnAccept:TSocketNotifyEvent read FOnAccept write FOnAccept;
  329.        Property OnError:TSocketErrorEvent read FOnError write FOnError;
  330.     Public
  331.        Procedure Open;
  332.        Procedure Close;
  333.   End;
  334.  
  335.   TWinSocketStream=Class(TStream)
  336.     Private
  337.        FSocket: TCustomWinSocket;
  338.        FTimeout: Longint;
  339.        FEvent: TSimpleEvent;
  340.     Public
  341.        Constructor Create(ASocket:TCustomWinSocket;TimeOut:Longint);
  342.        Destructor Destroy; Override;
  343.        Function WaitForData(Timeout:Longint):Boolean;
  344.        Function Read(Var Buffer;Count:Longint):Longint; Override;
  345.        Function Write(Const Buffer;Count:Longint):Longint; Override;
  346.        Function Seek(Offset:Longint;Origin:Word):Longint; Override;
  347.     Public
  348.        Property TimeOut:Longint read FTimeout write FTimeout;
  349.   End;
  350.  
  351.   TClientSocket=Class(TCustomSocket)
  352.     Private
  353.        FClientSocket: TClientWinSocket;
  354.     Private
  355.        Procedure DoActivate(Value:Boolean); Override;
  356.     Protected
  357.        Function GetClientType:TClientType;
  358.        Procedure SetClientType(Value:TClientType);
  359.     Public
  360.        Constructor Create(AOwner:TComponent); Override;
  361.        Destructor Destroy; Override;
  362.     Public
  363.        Property Socket:TClientWinSocket read FClientSocket;
  364.     Published
  365.        Property Active;
  366.        Property Address;
  367.        Property ClientType:TClientType read GetClientType write SetClientType;
  368.        Property Host;
  369.        Property Port;
  370.        Property Service;
  371.        Property OnLookup;
  372.        Property OnConnecting;
  373.        Property OnConnect;
  374.        Property OnDisconnect;
  375.        Property OnRead;
  376.        Property OnWrite;
  377.        Property OnError;
  378.   End;
  379.  
  380.   TServerSocket = class(TCustomSocket)
  381.     Private
  382.        Procedure DoActivate(Value:Boolean); Override;
  383.     Protected
  384.        FServerSocket: TServerWinSocket;
  385.     Protected
  386.        Function GetServerType:TServerType;
  387.        Function GetGetThreadEvent:TGetThreadEvent;
  388.        Function GetGetSocketEvent:TGetSocketEvent;
  389.        Function GetThreadCacheSize:LongInt;
  390.        Function GetOnThreadStart:TThreadNotifyEvent;
  391.        Function GetOnThreadEnd:TThreadNotifyEvent;
  392.        Function GetOnClientConnect:TSocketNotifyEvent;
  393.        Function GetOnClientDisconnect:TSocketNotifyEvent;
  394.        Function GetOnClientDisconnected:TSocketNotifyEvent;
  395.        Function GetOnClientRead:TSocketNotifyEvent;
  396.        Function GetOnClientWrite:TSocketNotifyEvent;
  397.        Function GetOnClientError:TSocketErrorEvent;
  398.        Procedure SetServerType(Value:TServerType);
  399.        Procedure SetGetThreadEvent(Value:TGetThreadEvent);
  400.        Procedure SetGetSocketEvent(Value:TGetSocketEvent);
  401.        Procedure SetThreadCacheSize(Value:LongInt);
  402.        Procedure SetOnThreadStart(Value:TThreadNotifyEvent);
  403.        Procedure SetOnThreadEnd(Value:TThreadNotifyEvent);
  404.        Procedure SetOnClientConnect(Value:TSocketNotifyEvent);
  405.        Procedure SetOnClientDisconnect(Value:TSocketNotifyEvent);
  406.        Procedure SetOnClientDisconnected(Value:TSocketNotifyEvent);
  407.        Procedure SetOnClientRead(Value:TSocketNotifyEvent);
  408.        Procedure SetOnClientWrite(Value:TSocketNotifyEvent);
  409.        Procedure SetOnClientError(Value:TSocketErrorEvent);
  410.     Public
  411.        Constructor Create(AOwner: TComponent); Override;
  412.        Destructor Destroy; Override;
  413.     Public
  414.        Property Socket: TServerWinSocket read FServerSocket;
  415.     Published
  416.        Property Active;
  417.        Property Port;
  418.        Property Service;
  419.        Property OnListen;
  420.        Property OnAccept;
  421.        Property ServerType:TServerType read GetServerType write SetServerType;
  422.        Property ThreadCacheSize:LongInt read GetThreadCacheSize write SetThreadCacheSize;
  423.        Property OnGetThread:TGetThreadEvent read GetGetThreadEvent write SetGetThreadEvent;
  424.        Property OnGetSocket:TGetSocketEvent read GetGetSocketEvent write SetGetSocketEvent;
  425.        Property OnThreadStart:TThreadNotifyEvent read GetOnThreadStart write SetOnThreadStart;
  426.        Property OnThreadEnd:TThreadNotifyEvent read GetOnThreadEnd write SetOnThreadEnd;
  427.        Property OnClientConnect:TSocketNotifyEvent read GetOnClientConnect write SetOnClientConnect;
  428.        Property OnClientDisconnect:TSocketNotifyEvent read GetOnClientDisconnect write SetOnClientDisconnect;
  429.        Property OnClientDisconnected:TSocketNotifyEvent read GetOnClientDisconnected write SetOnClientDisconnected;
  430.        Property OnClientRead:TSocketNotifyEvent read GetOnClientRead write SetOnClientRead;
  431.        Property OnClientWrite:TSocketNotifyEvent read GetOnClientWrite write SetOnClientWrite;
  432.        Property OnClientError:TSocketErrorEvent read GetOnClientError write SetOnClientError;
  433.   End;
  434.  
  435. ThreadVar SocketErrorProc:Procedure(ErrorCode:Word);
  436.  
  437. Implementation
  438.  
  439. Const
  440.      INADDR_ANY              =$00000000;
  441.      PF_INET                 =2;
  442.      SOCK_STREAM             =1;               /* stream socket */
  443.      IPPROTO_IP              =0;               /* dummy for IP */
  444.  
  445.      FD_READ         =$01;
  446.      FD_WRITE        =$02;
  447.      FD_OOB          =$04;
  448.      FD_ACCEPT       =$08;
  449.      FD_CONNECT      =$10;
  450.      FD_CLOSE        =$20;
  451.  
  452.      INVALID_SOCKET  = -1;
  453.      SOCKET_ERROR    = -1;
  454.  
  455.      IOCPARM_MASK    = $7f;
  456.      IOC_VOID        = $20000000;
  457.      IOC_OUT         = $40000000;
  458.      IOC_IN          = $80000000;
  459.      IOC_INOUT       = IOC_IN Or IOC_OUT;
  460.      FIONREAD        = IOC_OUT Or ((Longint(SizeOf(Longint)) And IOCPARM_MASK) Shl 16) Or
  461.                        (Longint(Byte('f')) Shl 8) Or 127;
  462.      FIONBIO         = IOC_IN Or ((Longint(SizeOf(Longint)) And IOCPARM_MASK) Shl 16) Or
  463.                        (Longint(Byte('f')) shl 8) Or 126;
  464.      FIOASYNC        = IOC_IN Or ((Longint(SizeOf(Longint)) And IOCPARM_MASK) Shl 16) Or
  465.                        (Longint(Byte('f')) Shl 8) Or 125;
  466.  
  467.      SOMAXCONN       =5;
  468.  
  469. Uses Forms;
  470.  
  471. Const
  472.      WSABASEERR              =10000;
  473.      WSAEINTR                =(WSABASEERR+4);
  474.      WSAEBADF                =(WSABASEERR+9);
  475.      WSAEACCES               =(WSABASEERR+13);
  476.      WSAEFAULT               =(WSABASEERR+14);
  477.      WSAEINVAL               =(WSABASEERR+22);
  478.      WSAEMFILE               =(WSABASEERR+24);
  479.      WSAEWOULDBLOCK          =(WSABASEERR+35);
  480.      WSAEINPROGRESS          =(WSABASEERR+36);
  481.      WSAEALREADY             =(WSABASEERR+37);
  482.      WSAENOTSOCK             =(WSABASEERR+38);
  483.      WSAEDESTADDRREQ         =(WSABASEERR+39);
  484.      WSAEMSGSIZE             =(WSABASEERR+40);
  485.      WSAEPROTOTYPE           =(WSABASEERR+41);
  486.      WSAENOPROTOOPT          =(WSABASEERR+42);
  487.      WSAEPROTONOSUPPORT      =(WSABASEERR+43);
  488.      WSAESOCKTNOSUPPORT      =(WSABASEERR+44);
  489.      WSAEOPNOTSUPP           =(WSABASEERR+45);
  490.      WSAEPFNOSUPPORT         =(WSABASEERR+46);
  491.      WSAEAFNOSUPPORT         =(WSABASEERR+47);
  492.      WSAEADDRINUSE           =(WSABASEERR+48);
  493.      WSAEADDRNOTAVAIL        =(WSABASEERR+49);
  494.      WSAENETDOWN             =(WSABASEERR+50);
  495.      WSAENETUNREACH          =(WSABASEERR+51);
  496.      WSAENETRESET            =(WSABASEERR+52);
  497.      WSAECONNABORTED         =(WSABASEERR+53);
  498.      WSAECONNRESET           =(WSABASEERR+54);
  499.      WSAENOBUFS              =(WSABASEERR+55);
  500.      WSAEISCONN              =(WSABASEERR+56);
  501.      WSAENOTCONN             =(WSABASEERR+57);
  502.      WSAESHUTDOWN            =(WSABASEERR+58);
  503.      WSAETOOMANYREFS         =(WSABASEERR+59);
  504.      WSAETIMEDOUT            =(WSABASEERR+60);
  505.      WSAECONNREFUSED         =(WSABASEERR+61);
  506.      WSAELOOP                =(WSABASEERR+62);
  507.      WSAENAMETOOLONG         =(WSABASEERR+63);
  508.      WSAEHOSTDOWN            =(WSABASEERR+64);
  509.      WSAEHOSTUNREACH         =(WSABASEERR+65);
  510.      WSAENOTEMPTY            =(WSABASEERR+66);
  511.      WSAEPROCLIM             =(WSABASEERR+67);
  512.      WSAEUSERS               =(WSABASEERR+68);
  513.      WSAEDQUOT               =(WSABASEERR+69);
  514.      WSAESTALE               =(WSABASEERR+70);
  515.      WSAEREMOTE              =(WSABASEERR+71);
  516.      WSASYSNOTREADY          =(WSABASEERR+91);
  517.      WSAVERNOTSUPPORTED      =(WSABASEERR+92);
  518.      WSANOTINITIALISED       =(WSABASEERR+93);
  519.      WSAHOST_NOT_FOUND       =(WSABASEERR+1001);
  520.      HOST_NOT_FOUND          =WSAHOST_NOT_FOUND;
  521.      WSATRY_AGAIN            =(WSABASEERR+1002);
  522.      TRY_AGAIN               =WSATRY_AGAIN;
  523.      WSANO_RECOVERY          =(WSABASEERR+1003);
  524.      NO_RECOVERY             =WSANO_RECOVERY;
  525.      WSANO_DATA              =(WSABASEERR+1004);
  526.      NO_DATA                 =WSANO_DATA;
  527.      WSANO_ADDRESS           =WSANO_DATA;
  528.      NO_ADDRESS              =WSANO_ADDRESS;
  529.  
  530.  
  531. Function SocketErrorMsg(ErrorCode:Word):String;
  532. Begin
  533.      Case ErrorCode Of
  534.          WSAEINTR:Result:='Blocking call canceled';
  535.          WSAEFAULT:Result:='Parameter fault';
  536.          WSAEINVAL:Result:='No listen call for accept';
  537.          WSAEMFILE:Result:='Queue empty for accept';
  538.          WSAEWOULDBLOCK:Result:='Call would block';
  539.          WSAEINPROGRESS:Result:='Blocking call in progress';
  540.          WSAENOTSOCK:Result:='Invalid socket handle';
  541.          WSAEDESTADDRREQ:Result:='Destination address required';
  542.          WSAEMSGSIZE:Result:='Datagram too large';
  543.          WSAENOPROTOOPT:Result:='Option not supported';
  544.          WSAEOPNOTSUPP:Result:='Invalid socket handle type';
  545.          WSAEAFNOSUPPORT:Result:='Address family not supported';
  546.          WSAEADDRINUSE:Result:='Address is in use';
  547.          WSAEADDRNOTAVAIL:Result:='Address not available';
  548.          WSAENETDOWN:Result:='Network subsystem failure';
  549.          WSAENETUNREACH:Result:='Network unreachable';
  550.          WSAENETRESET:Result:='Connection timed out';
  551.          WSAECONNABORTED:Result:='Connection aborted due to timeout or failure';
  552.          WSAECONNRESET:Result:='Connection reset by remote host';
  553.          WSAENOBUFS:Result:='No more buffer space';
  554.          WSAEISCONN:Result:='Socket already connected';
  555.          WSAENOTCONN:Result:='Socket not connected';
  556.          WSAESHUTDOWN:Result:='Socket has been shutdown';
  557.          WSAETIMEDOUT:Result:='TimeOut';
  558.          WSAECONNREFUSED:Result:='Connection rejected';
  559.          WSAENAMETOOLONG:Result:='Name too long';
  560.          WSAEHOSTDOWN:Result:='Host down';
  561.          WSAEHOSTUNREACH:Result:='Host unreachable';
  562.          WSASYSNOTREADY:Result:='System not ready';
  563.          WSAVERNOTSUPPORTED:Result:='Version not supported';
  564.          WSANOTINITIALISED:Result:='WinSock not initialized';
  565.          WSAHOST_NOT_FOUND:Result:='Host not found';
  566.          WSATRY_AGAIN:Result:='Try again';
  567.          WSANO_RECOVERY:Result:='No recovery';
  568.          WSANO_DATA:Result:='No data';
  569.          Else Result:='Unkown error';
  570.      End;
  571.      Result:=' ('+Result+'.)';
  572. End;
  573.  
  574.  
  575.  
  576. {
  577. ╔═══════════════════════════════════════════════════════════════════════════╗
  578. ║                                                                           ║
  579. ║ Speed-Pascal/2 Version 2.0                                                ║
  580. ║                                                                           ║
  581. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  582. ║                                                                           ║
  583. ║ This section: TCustomWinSocket Class Implementation                       ║
  584. ║                                                                           ║
  585. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  586. ║                                                                           ║
  587. ╚═══════════════════════════════════════════════════════════════════════════╝
  588. }
  589.  
  590. Type
  591.     TCMSocketMessage=Record
  592.         Msg: LongWord;
  593.         ReceiverClass: TObject;
  594.         Receiver: Longword;
  595.         Handled: LONGBOOL;  {True If the message was handled}
  596.         Socket: TSocket;
  597.         SelectEvent: Word;
  598.         SelectError: Word;
  599.         Result: Longint;
  600.     End;
  601.  
  602.     TSocketNotifyControl=Class(TControl)
  603.       Private
  604.          FSocket:TCustomWinSocket;
  605.          Procedure CreateWnd;Override;
  606.       Protected
  607.          Procedure SetupComponent;Override;
  608.          Procedure CMSocketMessage(Var Message: TCMSocketMessage); message CM_SOCKETMESSAGE;
  609.          Procedure CMDeferFree(Var Message:TMessage); message CM_DEFERFREE;
  610.     End;
  611.  
  612.  
  613. Procedure TSocketNotifyControl.CreateWnd; //dummy
  614. Begin
  615.     Inherited CreateWnd;
  616. End;
  617.  
  618. Procedure TSocketNotifyControl.SetupComponent;
  619. Begin
  620.      Inherited SetupComponent;
  621.      Include (ComponentState, csDetail);
  622. End;
  623.  
  624. Procedure TSocketNotifyControl.CMSocketMessage(Var Message: TCMSocketMessage);
  625. Var
  626.    ErrorEvent: TErrorEvent;
  627. Begin
  628.     Case Message.SelectEvent of
  629.       FD_READ:
  630.       Begin
  631.            Message.Handled:=True;
  632.            If Message.SelectError=0 Then
  633.            Begin
  634.                 FSocket.Read(Message.Socket);
  635.                 exit;
  636.            End
  637.            Else ErrorEvent:=eeReceive;
  638.       End;
  639.       FD_WRITE:
  640.       Begin
  641.            Message.Handled:=True;
  642.            If Message.SelectError=0 Then
  643.            Begin
  644.                FSocket.Write(Message.Socket);
  645.                exit;
  646.            End
  647.            Else ErrorEvent:=eeSend;
  648.       End;
  649.       FD_ACCEPT:
  650.       Begin
  651.            Message.Handled:=True;
  652.            If Message.SelectError=0 Then
  653.            Begin
  654.                FSocket.Accept(Message.Socket);
  655.                exit;
  656.            End
  657.            Else ErrorEvent:=eeAccept;
  658.       End;
  659.       FD_CLOSE:
  660.       Begin
  661.            Message.Handled:=True;
  662.            If Message.SelectError=0 Then
  663.            Begin
  664.                 FSocket.Disconnect(Message.Socket);
  665.                 exit;
  666.            End
  667.            Else ErrorEvent:=eeDisconnect;
  668.       End;
  669.       FD_CONNECT:
  670.       Begin
  671.            Message.Handled:=True;
  672.            If Message.SelectError=0 Then
  673.            Begin
  674.                 FSocket.Connect(Message.Socket);
  675.                 exit;
  676.            End
  677.            Else ErrorEvent:=eeConnect;
  678.       End;
  679.       Else ErrorEvent :=eeGeneral;
  680.     End; //case
  681.     FSocket.Error(FSocket,ErrorEvent,Message.SelectError);
  682.     If Message.SelectError<>0 Then
  683.       raise ESocketError.Create('Async socket error #'+tostr(Message.SelectError)+
  684.                                 SocketErrorMsg(Message.SelectError));
  685. End;
  686.  
  687.  
  688. Procedure TSocketNotifyControl.CMDeferFree(Var Message:TMessage);
  689. Begin
  690.      If FSocket<>Nil Then FSocket.Destroy;
  691.      FSocket:=Nil;
  692.      Message.Handled:=True;
  693. End;
  694.  
  695. Const WinSockHandle:LongWord=0;
  696.  
  697. Const
  698.     WSADESCRIPTION_LEN      =256;
  699.     WSASYS_STATUS_LEN       =128;
  700.  
  701. Type
  702.     WSAData=Record
  703.                wVersion:Word;
  704.                wHighVersion:Word;
  705.                szDescription: array[0..WSADESCRIPTION_LEN] of Char;
  706.                szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char;
  707.                iMaxSockets:Word;
  708.                iMaxUdpDg:Word;
  709.                lpVendorInfo:PChar;
  710.     End;
  711.     PWSADATA=^WSAData;
  712.  
  713. Type TWinSockProcs=Record
  714.         WSAStartup:Function(wVersionRequired:Word;Var aWSAData:WSAData):LongInt; CDecl;
  715.         WSACleanup:Function:LongInt; CDecl;
  716.         WSAGetLastError:Function:LongInt; CDecl;
  717.         getsockname:Function(s:TSOCKET;Var name;Var namelen:LongInt):LongInt; CDecl;
  718.         getpeername:Function(s:TSOCKET;Var name;Var nameLen:LongInt):LongInt; CDecl;
  719.         gethostname:Function(Const name:CString;namelen:LongInt):LongInt; CDecl;
  720.         inet_ntoa:Function(Var _in):PChar; CDecl;
  721.         gethostbyaddr:Function(Var addr;len,typ:LongInt):Pointer; CDecl;
  722.         ntohs:Function(netshort:Word):Word; CDecl;
  723.         gethostbyname:Function(Const name:CString):Pointer; CDecl;
  724.         getservbyname:Function(Const name,proto:CString):Pointer; CDecl;
  725.         inet_addr:Function(Const cp:CString):LongWord; CDecl;
  726.         htons:Function(hostshort:Word):Word; CDecl;
  727.         socket:Function(af,typ,protocol:LongInt):TSOCKET; CDecl;
  728.         accept:Function(s:TSOCKET;Var addr;Var addrlen:LongInt):TSOCKET; CDecl;
  729.         bind:Function(s:TSOCKET;Const addr;namelen:LongInt):LongInt; CDecl;
  730.         WSAAsyncSelect:Function(s:TSOCKET;ahWnd:LongWord;wMsg:LongWord;lEvent:LongInt):LongWord; CDecl;
  731.         listen:Function(s:TSOCKET;backlog:LongInt):LongInt; CDecl;
  732.         ioctlsocket:Function(s:TSOCKET;cmd:LongInt;Var argp:LongWord):LongInt; CDecl;
  733.         connect:Function(s:TSOCKET;Const name;namelen:LongInt):LongInt; CDecl;
  734.         closesocket:Function(s:TSOCKET):LongInt; CDecl;
  735.         send:Function(s:TSOCKET;Const Buf;len,flags:LongInt):LongInt; CDecl;
  736.         recv:Function(s:TSOCKET;Var Buf;len,flags:LongInt):LongInt; CDecl;
  737.         select:Function(nfds:LongInt;Var readfds,writefds,exceptfds;
  738.                         Const timeout):LongInt; CDecl;
  739.      End;
  740.  
  741. Var WinSockProcs:TWinSockProcs;
  742.  
  743. Function InitWinSock:BOOLEAN;
  744. Var c:Cstring;
  745.     ok:BOOLEAN;
  746.  
  747.     Function GetProcAddr(Const ProcName:String):Pointer;
  748.     Var S:cstring;
  749.     Begin
  750.        S:=ProcName;
  751.        {$IFDEF OS2}
  752.        If DosQueryProcAddr(WinSockHandle,0,S,Result)<>0 Then Raise Exception.Create(ProcName);
  753.        {$ENDIF}
  754.        {$IFDEF Win95}
  755.        Result:=GetProcAddress(WinSockHandle,S);
  756.        If Result=Nil Then Raise Exception.Create(ProcName);
  757.        {$ENDIF}
  758.     End;
  759.  
  760. Begin
  761.      result:=WinSockHandle<>0;
  762.      If result Then exit;
  763.  
  764.      {$IFDEF OS2}
  765.      If DosLoadModule(c,255,'PMWSOCK',WinSockHandle)<>0 Then
  766.      Begin
  767.           WinSockHandle:=0;
  768.           ErrorBox2('PMWSOCK.DLL not found. Sockets not available');
  769.           exit;
  770.      End;
  771.      {$ENDIF}
  772.      {$IFDEF WIN32}
  773.      WinSockHandle:=LoadLibrary('wsock32.dll');
  774.      If WinSockHandle=0 Then
  775.      Begin
  776.           WinSockHandle:=0;
  777.           ErrorBox2('WSOCK32.DLL not found. Sockets not available');
  778.           exit;
  779.      End;
  780.      {$ENDIF}
  781.  
  782.      ok:=TRUE;
  783.      With WinSockProcs Do
  784.      Begin
  785.         Try
  786.            WSAStartup:=Pointer(GetProcAddr('WSAStartup'));
  787.            WSACleanup:=Pointer(GetProcAddr('WSACleanup'));
  788.            WSAGetLastError:=Pointer(GetProcAddr('WSAGetLastError'));
  789.            getpeername:=Pointer(GetProcAddr('getpeername'));
  790.            getsockname:=Pointer(GetProcAddr('getsockname'));
  791.            socket:=Pointer(GetProcAddr('socket'));
  792.            inet_ntoa:=Pointer(GetProcAddr('inet_ntoa'));
  793.            gethostname:=Pointer(GetProcAddr('gethostname'));
  794.            gethostbyaddr:=Pointer(GetProcAddr('gethostbyaddr'));
  795.            ntohs:=Pointer(GetProcAddr('ntohs'));
  796.            gethostbyname:=Pointer(GetProcAddr('gethostbyname'));
  797.            getservbyname:=Pointer(GetProcAddr('getservbyname'));
  798.            inet_addr:=Pointer(GetProcAddr('inet_addr'));
  799.            htons:=Pointer(GetProcAddr('htons'));
  800.            accept:=Pointer(GetProcAddr('accept'));
  801.            bind:=Pointer(GetProcAddr('bind'));
  802.            WSAAsyncSelect:=Pointer(GetProcAddr('WSAAsyncSelect'));
  803.            listen:=Pointer(GetProcAddr('listen'));
  804.            ioctlsocket:=Pointer(GetProcAddr('ioctlsocket'));
  805.            connect:=Pointer(GetProcAddr('connect'));
  806.            closesocket:=Pointer(GetProcAddr('closesocket'));
  807.            send:=Pointer(GetProcAddr('send'));
  808.            recv:=Pointer(GetProcAddr('recv'));
  809.            select:=Pointer(GetProcAddr('select'));
  810.         Except
  811.              ok:=FALSE;
  812.              {$IFDEF OS2}
  813.              DosFreeModule(WinSockHandle);
  814.              {$ENDIF}
  815.              {$IFDEF WIN32}
  816.              FreeLibrary(WinSockHandle);
  817.              {$ENDIF}
  818.              WinSockHandle:=0;
  819.         End;
  820.      End;
  821.  
  822.      If Not ok Then raise ESocketError.Create('Windows sockets not available');
  823.  
  824.      result:=ok;
  825. End;
  826.  
  827.  
  828. Var
  829.   aWSAData: WSAData;
  830.  
  831. Procedure CheckSockError(Socket:TCustomWinSocket;Const Op:String);
  832. Var ErrorCode:Word;
  833. Begin
  834.      If WinSockHandle<>0 Then ErrorCode:=WinSockProcs.WSAGetLastError
  835.      Else ErrorCode:=0;
  836.      If ErrorCode<>WSAEWOULDBLOCK Then
  837.      Begin
  838.           Socket.Error(Socket,eeReceive,ErrorCode);
  839.           Socket.Disconnect(Socket.FSocket);
  840.           If ErrorCode <> 0 Then
  841.             raise ESocketError.Create('Socket error #'+tostr(ErrorCode)+' in '+Op+
  842.                                       SocketErrorMsg(ErrorCode));
  843.      End;
  844. End;
  845.  
  846. Procedure CheckSockResult(ResultCode: Integer; Const Op: String);
  847. Var Ret:LongInt;
  848. Begin
  849.     If ResultCode=0 Then exit; //no error
  850.     If WinSockHandle<>0 Then Ret:=WinSockProcs.WSAGetLastError
  851.     Else Ret:=0;
  852.     If Ret=WSAEWOULDBLOCK Then exit;
  853.     If SocketErrorProc<>Nil Then SocketErrorProc(Ret)
  854.     Else Raise ESocketError.Create('Windows socket error #'+tostr(Ret)+' in '+Op+
  855.                                    SocketErrorMsg(Ret));
  856. End;
  857.  
  858. Const CallCount:LongInt=0;
  859.  
  860. Constructor TCustomWinSocket.Create(ASocket: TSocket);
  861. Var ErrorCode:LongInt;
  862.     InsideDesigner:Boolean;
  863. Begin
  864.   Inherited Create;
  865.   InitWinSock;
  866.  
  867.   If CallCount=0 Then
  868.   Begin
  869.     If WinSockHandle<>0 Then
  870.     Begin
  871.         Asm
  872.             MOV AL,Classes.InsideDesigner
  873.             MOV InsideDesigner,AL
  874.          End;
  875.          If not InsideDesigner Then
  876.          Begin
  877.             ErrorCode := WinSockProcs.WSAStartup($0101, aWSAData);
  878.             If ErrorCode <> 0 Then
  879.               raise ESocketError.Create('Windows socket error #'+tostr(ErrorCode)+
  880.                                         SocketErrorMsg(ErrorCode));
  881.          End;
  882.     End;
  883.   End;
  884.   inc(CallCount);
  885.  
  886.   FSocket := ASocket;
  887.   FASyncStyles := [asRead, asWrite, asConnect, asClose];
  888.   FAddr.sin_addr.s_addr := INADDR_ANY;
  889.   FAddr.sin_port := 0;
  890.   FAddr.sin_family := PF_INET;
  891.   FConnected:=FSocket>0;
  892. End;
  893.  
  894. Destructor TCustomWinSocket.Destroy;
  895. Var ErrorCode:LongInt;
  896.     InsideDesigner:Boolean;
  897. Begin
  898.   FOnSocketEvent := nil;
  899.   If FSocket>0 Then Disconnect(FSocket);
  900.  
  901.   If FSocketControl<>Nil Then
  902.   Begin
  903.        TSocketNotifyControl(FSocketControl).FSocket:=Nil;
  904.        FSocketControl.Destroy;
  905.        FHandle:=0;
  906.   End;
  907.   FSocketControl:=Nil;
  908.   If CallCount>0 Then dec(CallCount);
  909.  
  910.   If CallCount=0 Then
  911.   Begin
  912.      If WinSockHandle<>0 Then
  913.      Begin
  914.          Asm
  915.             MOV AL,Classes.InsideDesigner
  916.             MOV InsideDesigner,AL
  917.          End;
  918.          If not InsideDesigner Then
  919.          Begin
  920.              ErrorCode := WinSockProcs.WSACleanup;
  921.              If ErrorCode <> 0 Then
  922.                raise ESocketError.Create('Windows socket error #'+tostr(ErrorCode)+
  923.                                          SocketErrorMsg(ErrorCode));
  924.          End;
  925.          {$IFDEF OS2}
  926.          DosFreeModule(WinSockHandle);
  927.          {$ENDIF}
  928.          {$IFDEF WIN32}
  929.          FreeLibrary(WinSockHandle);
  930.          {$ENDIF}
  931.          WinSockHandle:=0;
  932.      End;
  933.   End;
  934.  
  935.   Inherited Destroy;
  936. End;
  937.  
  938.  
  939. Procedure TCustomWinSocket.Accept(Socket: TSocket);
  940. Begin
  941. End;
  942.  
  943. Procedure TCustomWinSocket.Close;
  944. Begin
  945.      Disconnect(FSocket);
  946. End;
  947.  
  948. Procedure TCustomWinSocket.Connect(Socket: TSocket);
  949. Begin
  950. End;
  951.  
  952. Function TCustomWinSocket.GetHandle:LongWord;
  953. Begin
  954.     If FHandle = 0 Then
  955.     Begin
  956.          FSocketControl:=TSocketNotifyControl.Create(Nil);
  957.          TSocketNotifyControl(FSocketControl).FSocket:=Self;
  958.          TSocketNotifyControl(FSocketControl).CreateWnd;
  959.          FHandle:=FSocketControl.Handle;
  960.     End;
  961.     Result := FHandle;
  962. End;
  963.  
  964. Function TCustomWinSocket.GetRemoteAddr: TSockAddrIn;
  965. Var
  966.    Size:LongInt;
  967. Begin
  968.      FillChar(Result, SizeOf(TSockAddrIn), 0);
  969.      If not FConnected Then Exit;
  970.  
  971.      Size:=SizeOf(TSockAddrIn);
  972.      If WinSockHandle<>0 Then
  973.       If WinSockProcs.getpeername(FSocket,Result,Size)<>0 Then FillChar(Result,SizeOf(TSockAddrIn),0);
  974. End;
  975.  
  976. Function TCustomWinSocket.GetLocalAddress: String;
  977. Var
  978.   Size:LongInt;
  979.   SoIn:TSockAddrIn;
  980. Begin
  981.      Result:='';
  982.      If FSocket<=0 Then Exit; //invalid socket
  983.  
  984.      Size:=SizeOf(SoIn);
  985.      FillChar(SoIn,SizeOf(TSockAddrIn),0);
  986.      If WinSockHandle<>0 Then
  987.        If WinSockProcs.getsockname(FSocket,SoIn,Size)=0 Then
  988.          With SoIn.sin_Addr.S_un_b Do
  989.             Result:=tostr(s_b1)+'.'+tostr(s_b2)+'.'+tostr(s_b3)+'.'+tostr(s_b4);
  990. End;
  991.  
  992. Function TCustomWinSocket.GetRemoteAddress:String;
  993. Var
  994.    Size:LongInt;
  995.    SoIn:TSockAddrIn;
  996. Begin
  997.      Result := '';
  998.      If not FConnected Then Exit;
  999.  
  1000.      If WinSockHandle<>0 Then
  1001.      Begin
  1002.          Size:=SizeOf(SoIn);
  1003.          CheckSockResult(WinSockProcs.getpeername(FSocket,SoIn,Size),'getpeername');
  1004.          With SoIn.sin_Addr.S_un_b Do
  1005.            Result:=tostr(s_b1)+'.'+tostr(s_b2)+'.'+tostr(s_b3)+'.'+tostr(s_b4);
  1006.      End;
  1007. End;
  1008.  
  1009. Function TCustomWinSocket.GetLocalHost:String;
  1010. Var
  1011.    LocName:CString;
  1012. Begin
  1013.     Result:='';
  1014.     If FSocket<=0 Then Exit; //invalid socket
  1015.  
  1016.     If WinSockHandle<>0 Then
  1017.       If WinSockProcs.gethostname(LocName,255)=0 Then Result:=LocName;
  1018. End;
  1019.  
  1020. Type
  1021.     PCharArray=^TCharArray;
  1022.     TCharArray=Array[0..0] Of PChar;
  1023.  
  1024.     hostent=Record
  1025.        h_name:PChar;             /* official name of host */
  1026.        h_aliases:PCharArray;     /* alias list */
  1027.        h_addrtype:LongInt;       /* host address type */
  1028.        h_length:LongInt;         /* length of address */
  1029.        h_addr_list:PCharArray;   /* list of addresses from name server */
  1030.        //h_addr  h_addr_list[0]  /* address, for backward compatiblity */
  1031.     End;
  1032.     phostent=^hostent;
  1033.  
  1034. Function TCustomWinSocket.GetRemoteHost:String;
  1035. Var
  1036.   Size:LongInt;
  1037.   aHostEnt:PHostEnt;
  1038.   SoIn:TSockAddrIn;
  1039. Begin
  1040.      Result:='';
  1041.      If not FConnected Then Exit;
  1042.  
  1043.      If WinSockHandle<>0 Then
  1044.      Begin
  1045.          Size:=SizeOf(SoIn);
  1046.          CheckSockResult(WinSockProcs.getpeername(FSocket,SoIn,Size),'getpeername');
  1047.          aHostEnt:=WinSockProcs.gethostbyaddr(SoIn.sin_addr.s_addr,4,PF_INET);
  1048.          If aHostEnt<>Nil Then Result:=aHostEnt^.h_name^;
  1049.      End;
  1050. End;
  1051.  
  1052. Function TCustomWinSocket.GetLocalPort:LongInt;
  1053. Var
  1054.   Size:LongInt;
  1055.   SoIn:TSockAddrIn;
  1056. Begin
  1057.      Result:=-1;
  1058.      If FSocket<=0 Then Exit; //invalid socket
  1059.  
  1060.      If WinSockHandle<>0 Then
  1061.      Begin
  1062.         Size := SizeOf(SoIn);
  1063.         If WinSockProcs.getsockname(FSocket,SoIn,Size)=0 Then
  1064.           Result:=WinSockProcs.ntohs(SoIn.sin_port);
  1065.      End;
  1066. End;
  1067.  
  1068. Function TCustomWinSocket.GetRemotePort: LongInt;
  1069. Var
  1070.    Size:LongInt;
  1071.    SoIn:TSockAddrIn;
  1072. Begin
  1073.      Result := 0;
  1074.      If not FConnected Then Exit;
  1075.  
  1076.      If WinSockHandle<>0 Then
  1077.      Begin
  1078.          Size:=SizeOf(SoIn);
  1079.          CheckSockResult(WinSockProcs.getpeername(FSocket,SoIn,Size),'getpeername');
  1080.          Result:=WinSockProcs.ntohs(SoIn.sin_port);
  1081.      End;
  1082. End;
  1083.  
  1084. Function TCustomWinSocket.LookupName(Const Name: String): TInAddr;
  1085. Var
  1086.    HostEnt: PHostEnt;
  1087. Begin
  1088.      FillChar(Result, SizeOf(TInAddr),0);
  1089.      If WinSockHandle<>0 Then HostEnt:=WinSockProcs.gethostbyname(Name)
  1090.      Else exit;
  1091.      If HostEnt=Nil Then exit;
  1092.  
  1093.      Result.S_un_b.s_b1 := Byte(HostEnt^.h_addr_list^[0]^[0]);
  1094.      Result.S_un_b.s_b2 := Byte(HostEnt^.h_addr_list^[0]^[1]);
  1095.      Result.S_un_b.s_b3 := Byte(HostEnt^.h_addr_list^[0]^[2]);
  1096.      Result.S_un_b.s_b4 := Byte(HostEnt^.h_addr_list^[0]^[3]);
  1097. End;
  1098.  
  1099. Type
  1100.    servent=Record
  1101.        s_name:PChar;
  1102.        s_aliases:PCharArray;
  1103.        s_port:LongInt;
  1104.        s_proto:PChar;
  1105.    End;
  1106.    pservent=^servent;
  1107.  
  1108. Function TCustomWinSocket.LookupService(Const Service: String): LongInt;
  1109. Var
  1110.    aServEnt: PServEnt;
  1111. Begin
  1112.     Result:=0;
  1113.     If WinSockHandle<>0 Then aServEnt:=WinSockProcs.getservbyname(Service, 'tcp')
  1114.     Else exit;
  1115.     If aServEnt=Nil Then exit;
  1116.     Result:=WinSockProcs.ntohs(aServEnt^.s_port)
  1117. End;
  1118.  
  1119. Function TCustomWinSocket.InitSocket(Var Name,Address,Service:String;Port:Word;
  1120.                                      Client:Boolean):TSockAddrIn;
  1121. Begin
  1122.      FillChar(Result,sizeof(Result),0);
  1123.      Result.sin_family := PF_INET;
  1124.      If Name<>'' Then Result.sin_addr:=LookupName(name)
  1125.      Else If Address<>'' Then
  1126.      Begin
  1127.           If WinSockHandle<>0 Then Result.sin_addr.s_addr:=WinSockProcs.inet_addr(Address)
  1128.           Else Raise ESocketError.Create('Sockets not available');
  1129.      End
  1130.      Else If not Client Then Result.sin_addr.s_addr:=INADDR_ANY
  1131.      Else Raise ESocketError.Create('No socket address');
  1132.  
  1133.      If Service<>'' Then
  1134.      Begin
  1135.           If WinSockHandle<>0 Then Result.sin_port:=WinSockProcs.htons(LookupService(Service))
  1136.           Else Raise ESocketError.Create('Sockets not available');
  1137.      End
  1138.      Else
  1139.      Begin
  1140.           If WinSockHandle<>0 Then Result.sin_port:=WinSockProcs.htons(Port)
  1141.           Else Raise ESocketError.Create('Sockets not available');
  1142.      End;
  1143. End;
  1144.  
  1145. Procedure TCustomWinSocket.Listen(Var Name,Address,Service:String;Port:Word;QueueSize:LongInt);
  1146. Var
  1147.    SoIn: TSockAddrIn;
  1148.    Blocking:LongWord;
  1149. Begin
  1150.      If FConnected Then Raise ESocketError.Create('Socket cannot listen on open');
  1151.      If FSocket>0 Then
  1152.      Begin
  1153.           If WinSockHandle<>0 Then CheckSockResult(WinSockProcs.closesocket(FSocket), 'closesocket');
  1154.      End;
  1155.      If WinSockHandle<>0 Then FSocket:=WinSockProcs.socket(PF_INET, SOCK_STREAM, IPPROTO_IP)
  1156.      Else FSocket:=INVALID_SOCKET;
  1157.      If FSocket<=0 Then Raise ESocketError.Create('Cannot create socket');
  1158.  
  1159.      Try
  1160.         SoIn:=InitSocket(Name,Address,Service,Port,False);
  1161.         CheckSockResult(WinSockProcs.bind(FSocket, SoIn, SizeOf(TSockAddrIn)),'bind');
  1162.         If FAsyncStyles<>[] Then WinSockProcs.WSAAsyncSelect(FSocket,Handle,CM_SOCKETMESSAGE,Longint(FAsyncStyles))
  1163.         Else
  1164.         Begin
  1165.              WinSockProcs.WSAAsyncSelect(FSocket,0,WM_NULL,0);
  1166.              Blocking := 0;
  1167.              WinSockProcs.ioctlsocket(FSocket,FIONBIO,Blocking);
  1168.         End;
  1169.  
  1170.         Event(Self,seListen);
  1171.         If QueueSize>SOMAXCONN Then QueueSize:=SOMAXCONN;
  1172.         CheckSockResult(WinSockProcs.listen(FSocket, QueueSize), 'listen');
  1173.         FConnected := True;
  1174.      Except
  1175.         Disconnect(FSocket);
  1176.         Raise;
  1177.      End;
  1178. End;
  1179.  
  1180. Procedure TCustomWinSocket.Open(Var Name,Address,Service:String;Port:Word);
  1181. Var
  1182.    SoIn:TSockAddrIn;
  1183.    Blocking:LongWord;
  1184. Begin
  1185.      If FConnected Then raise ESocketError.Create('Socket already open');
  1186.  
  1187.      If WinSockHandle<>0 Then FSocket:=WinSockProcs.socket(PF_INET, SOCK_STREAM, IPPROTO_IP)
  1188.      Else FSocket:=INVALID_SOCKET;
  1189.      If FSocket<=0 Then Raise ESocketError.Create('Cannot create socket');
  1190.  
  1191.      Try
  1192.         Event(Self, seLookUp);
  1193.         SoIn := InitSocket(Name, Address, Service, Port, True);
  1194.         If FAsyncStyles=[] Then
  1195.         Begin
  1196.              WinSockProcs.WSAAsyncSelect(FSocket,0,WM_NULL,0);
  1197.              Blocking := 0;
  1198.              WinSockProcs.ioctlsocket(FSocket,FIONBIO,Blocking);
  1199.         End
  1200.         Else WinSockProcs.WSAAsyncSelect(FSocket,Handle,CM_SOCKETMESSAGE,Longint(FAsyncStyles));
  1201.  
  1202.         Event(Self,seConnecting);
  1203.  
  1204.         CheckSockResult(WinSockProcs.connect(FSocket,SoIn, SizeOf(TSockAddrIn)),'connect');
  1205.         If not (asConnect In FAsyncStyles) Then
  1206.         Begin
  1207.             FConnected:=FSocket>0;
  1208.             Event(Self,seConnect);
  1209.         End;
  1210.      Except
  1211.         Disconnect(FSocket);
  1212.         Raise;
  1213.      End;
  1214. End;
  1215.  
  1216. Procedure TCustomWinSocket.Read(Socket: TSocket);
  1217. Begin
  1218.      If ((FSocket<=0)Or(Socket<>FSocket)) Then Exit;
  1219.      Event(Self, seRead);
  1220. End;
  1221.  
  1222. Procedure TCustomWinSocket.Write(Socket: TSocket);
  1223. Var Stream:TStream;
  1224. Begin
  1225.      If ((FSocket<=0)Or(Socket<>FSocket)) Then Exit;
  1226.      Stream:=FSendStream;
  1227.      FSendStream:=Nil;
  1228.      If not SendStream(Stream) Then Event(Self, seWrite);
  1229. End;
  1230.  
  1231.  
  1232. Procedure TCustomWinSocket.Disconnect(Socket: TSocket);
  1233. Begin
  1234.      If not FConnected Then exit;
  1235.  
  1236.      If ((Socket<=0)Or(Socket<>FSocket)) Then exit;
  1237.  
  1238.      Event(Self, seDisconnect);
  1239.      If WinSockHandle<>0 Then
  1240.      Begin
  1241.           WinSockProcs.WSAAsyncSelect(FSocket,0,WM_NULL,0);
  1242.  
  1243.           IF FSocket<0 Then
  1244.           Begin
  1245.               FSocket:=INVALID_SOCKET;
  1246.               FConnected:=False;
  1247.               exit;
  1248.           End;
  1249.           CheckSockResult(WinSockProcs.closesocket(FSocket), 'closesocket');
  1250.      End;
  1251.      FSocket:=INVALID_SOCKET;
  1252.      FConnected:=False;
  1253.      If FSendStream<>Nil Then
  1254.      Begin
  1255.          FSendStream.Destroy;
  1256.          FSendStream := nil;
  1257.      End;
  1258.  
  1259.      Event(Self, seDisconnected);
  1260. End;
  1261.  
  1262. Procedure TCustomWinSocket.Event(Socket:TCustomWinSocket;SocketEvent:TSocketEvent);
  1263. Begin
  1264.      If FOnSocketEvent<>Nil Then FOnSocketEvent(Self,Socket,SocketEvent);
  1265. End;
  1266.  
  1267. Procedure TCustomWinSocket.Error(Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  1268.                                  Var ErrorCode:Word);
  1269. Begin
  1270.      If FOnErrorEvent<>Nil Then FOnErrorEvent(Self,Socket,ErrorEvent,ErrorCode);
  1271. End;
  1272.  
  1273. Procedure TCustomWinSocket.SendText(Const s: String);
  1274. Begin
  1275.      SendBuf(S[1], Length(S));
  1276. End;
  1277.  
  1278. Function TCustomWinSocket.SendStream(AStream: TStream): Boolean;
  1279. Var
  1280.    BufferBytesLeft:LongInt;
  1281.    BufferBytesSent:LongInt;
  1282.    ErrorCode:Word;
  1283.    Buf:Array[0..4095] of Byte;
  1284.    StartPos:LongInt;
  1285. Label ex;
  1286. Begin
  1287.      Result := False;
  1288.      If WinSockHandle=0 Then exit;
  1289.  
  1290.      If FSendStream = nil Then
  1291.      Begin
  1292.          FSendStream := AStream;
  1293.  
  1294.          If FSendStream=Nil Then exit;
  1295.          If ((FSocket<=0)Or(not FConnected)) Then exit;
  1296.  
  1297.          Repeat
  1298.              StartPos:=FSendStream.Position;
  1299.              BufferBytesLeft:=FSendStream.Read(Buf,SizeOf(Buf));
  1300.  
  1301.              If BufferBytesLeft>0 Then
  1302.              Begin
  1303.                   BufferBytesSent:=WinSockProcs.send(FSocket,Buf,BufferBytesLeft,0);
  1304.                   If BufferBytesSent=SOCKET_ERROR Then
  1305.                   Begin
  1306.                       ErrorCode := WinSockProcs.WSAGetLastError;
  1307.                       If ErrorCode <> WSAEWOULDBLOCK Then
  1308.                       Begin
  1309.                            Error(Self,eeSend, ErrorCode);
  1310.                            Disconnect(FSocket);
  1311.                            goto ex;
  1312.                       End
  1313.                       Else
  1314.                       Begin
  1315.                            FSendStream.Position:=StartPos;
  1316.                            Result:=True;
  1317.                            exit;
  1318.                       End;
  1319.                   End
  1320.                   Else If BufferBytesLeft>BufferBytesSent Then FSendStream.Position:=StartPos+(BufferBytesLeft-BufferBytesSent)
  1321.                   Else If FSendStream.Position=FSendStream.Size Then goto ex;
  1322.              End
  1323.              Else
  1324.              Begin
  1325. ex:
  1326.                  If FDropAfterSend Then Disconnect(FSocket);
  1327.                  FDropAfterSend := False;
  1328.                  FSendStream.Destroy;
  1329.                  FSendStream := nil;
  1330.                  Result:=True;
  1331.                  exit;
  1332.              End;
  1333.          Until False;
  1334.      End;
  1335. End;
  1336.  
  1337. Function TCustomWinSocket.SendStreamThenDrop(AStream: TStream): Boolean;
  1338. Begin
  1339.      FDropAfterSend := True;
  1340.      Result := SendStream(AStream);
  1341.      If not Result Then FDropAfterSend:=False;
  1342. End;
  1343.  
  1344. Function TCustomWinSocket.SendBuf(Var Buf;Count:LongInt):LongInt;
  1345. Var
  1346.    ErrorCode:Word;
  1347. Begin
  1348.     Result := 0;
  1349.     If not FConnected Then Exit;
  1350.     If WinSockHandle=0 Then exit;
  1351.  
  1352.     Result:=WinSockProcs.send(FSocket, Buf, Count, 0);
  1353.     If Result=SOCKET_ERROR Then CheckSockError(Self,'send');
  1354. End;
  1355.  
  1356. Procedure TCustomWinSocket.SetAsyncStyles(Value: TASyncStyles);
  1357. Var Blocking:LongWord;
  1358. Begin
  1359.      If Value <> FASyncStyles Then
  1360.      Begin
  1361.           FASyncStyles := Value;
  1362.           If WinSockHandle=0 Then exit;
  1363.           If FSocket>0 Then
  1364.           Begin
  1365.             If FAsyncStyles<>[] Then WinSockProcs.WSAAsyncSelect(FSocket,Handle,CM_SOCKETMESSAGE,Longint(FAsyncStyles))
  1366.             Else
  1367.             Begin
  1368.                 WinSockProcs.WSAAsyncSelect(FSocket,0,WM_NULL,0);
  1369.                 Blocking := 0;
  1370.                 WinSockProcs.ioctlsocket(FSocket,FIONBIO,Blocking);
  1371.             End;
  1372.           End;
  1373.      End;
  1374. End;
  1375.  
  1376. Function TCustomWinSocket.ReceiveBuf(Var Buf; Count: LongInt): LongInt;
  1377. Var
  1378.    ErrorCode:Word;
  1379. Begin
  1380.     Result := 0;
  1381.     If not FConnected Then Exit;
  1382.     If WinSockHandle=0 Then exit;
  1383.  
  1384.     If ((Count=-1)And(FConnected)) Then WinSockProcs.ioctlsocket(FSocket,FIONREAD,LongWord(Result))
  1385.     Else
  1386.     Begin
  1387.          Result:=WinSockProcs.recv(FSocket, Buf, Count, 0);
  1388.          If Result = SOCKET_ERROR Then CheckSockError(Self,'recv');
  1389.     End;
  1390. End;
  1391.  
  1392. Function TCustomWinSocket.ReceiveLength: LongInt;
  1393. Var p:Pointer;
  1394. Begin
  1395.      p:=Nil;
  1396.      Result := ReceiveBuf(p^, -1);
  1397. End;
  1398.  
  1399. Function TCustomWinSocket.ReceiveText: String;
  1400. Var p:Pointer;
  1401. Begin
  1402.      p:=Nil;
  1403.      SetLength(Result, ReceiveBuf(p^, -1));
  1404.      ReceiveBuf(Result[1], Length(Result));
  1405. End;
  1406.  
  1407. {
  1408. ╔═══════════════════════════════════════════════════════════════════════════╗
  1409. ║                                                                           ║
  1410. ║ Speed-Pascal/2 Version 2.0                                                ║
  1411. ║                                                                           ║
  1412. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  1413. ║                                                                           ║
  1414. ║ This section: TClientWinSocket Class Implementation                       ║
  1415. ║                                                                           ║
  1416. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  1417. ║                                                                           ║
  1418. ╚═══════════════════════════════════════════════════════════════════════════╝
  1419. }
  1420.  
  1421. Procedure TClientWinSocket.Connect(Socket: TSocket);
  1422. Begin
  1423.      FConnected:=True;
  1424.      Event(Self, seConnect);
  1425. End;
  1426.  
  1427. Procedure TClientWinSocket.SetClientType(Value: TClientType);
  1428. Begin
  1429.      If Value=FClientType Then exit;
  1430.  
  1431.      If FConnected Then Raise ESocketError.Create('Cannot change socket while active');
  1432.  
  1433.      FClientType := Value;
  1434.      If FClientType=ctBlocking Then ASyncStyles:=[]
  1435.      Else ASyncStyles:=[asRead,asWrite,asConnect,asClose];
  1436. End;
  1437.  
  1438. {
  1439. ╔═══════════════════════════════════════════════════════════════════════════╗
  1440. ║                                                                           ║
  1441. ║ Speed-Pascal/2 Version 2.0                                                ║
  1442. ║                                                                           ║
  1443. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  1444. ║                                                                           ║
  1445. ║ This section: TServerClientWinSocket Class Implementation                 ║
  1446. ║                                                                           ║
  1447. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  1448. ║                                                                           ║
  1449. ╚═══════════════════════════════════════════════════════════════════════════╝
  1450. }
  1451.  
  1452. Constructor TServerClientWinSocket.Create(Socket: TSocket;ServerWinSocket:TServerWinSocket);
  1453. Var Blocking:LongWord;
  1454. Begin
  1455.      FServerWinSocket := ServerWinSocket;
  1456.      If FServerWinSocket<>Nil Then
  1457.      Begin
  1458.          If FServerWinSocket.FConnections.IndexOf(Self)<0 Then
  1459.            FServerWinSocket.FConnections.Add(Self);
  1460.          If FServerWinSocket.AsyncStyles <> [] Then
  1461.            OnSocketEvent := FServerWinSocket.ClientEvent;
  1462.      End;
  1463.  
  1464.      Inherited Create(Socket);
  1465.  
  1466.      If FServerWinSocket.ASyncStyles <> [] Then
  1467.       If WinSockHandle<>0 Then
  1468.      Begin
  1469.           If FAsyncStyles<>[] Then WinSockProcs.WSAAsyncSelect(FSocket,Handle,CM_SOCKETMESSAGE,Longint(FAsyncStyles))
  1470.           Else
  1471.           Begin
  1472.               WinSockProcs.WSAAsyncSelect(FSocket,0,WM_NULL,0);
  1473.               Blocking := 0;
  1474.               WinSockProcs.ioctlsocket(FSocket,FIONBIO,Blocking);
  1475.           End;
  1476.      End;
  1477.      If FConnected Then Event(Self, seConnect);
  1478. End;
  1479.  
  1480. Destructor TServerClientWinSocket.Destroy;
  1481. Begin
  1482.      If FServerWinSocket<>Nil Then
  1483.      Begin
  1484.           If FServerWinSocket.FConnections.IndexOf(Self)>=0 Then
  1485.             FServerWinSocket.FConnections.Remove(Self);
  1486.      End;
  1487.      Inherited Destroy;
  1488. End;
  1489.  
  1490. {
  1491. ╔═══════════════════════════════════════════════════════════════════════════╗
  1492. ║                                                                           ║
  1493. ║ Speed-Pascal/2 Version 2.0                                                ║
  1494. ║                                                                           ║
  1495. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  1496. ║                                                                           ║
  1497. ║ This section: TServerWinSocket Class Implementation                       ║
  1498. ║                                                                           ║
  1499. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  1500. ║                                                                           ║
  1501. ╚═══════════════════════════════════════════════════════════════════════════╝
  1502. }
  1503.  
  1504. Constructor TServerWinSocket.Create(ASocket: TSocket);
  1505. Begin
  1506.      FConnections.Create;
  1507.      FActiveThreads.Create;
  1508.      Inherited Create(ASocket);
  1509.      FAsyncStyles:=[asAccept];
  1510. End;
  1511.  
  1512. Destructor TServerWinSocket.Destroy;
  1513. Begin
  1514.      Inherited Destroy;
  1515.      FConnections.Destroy;
  1516.      FActiveThreads.Destroy;
  1517. End;
  1518.  
  1519. Procedure TServerWinSocket.ClientEvent(Sender:TObject;Socket:TCustomWinSocket;
  1520.                                        SocketEvent:TSocketEvent);
  1521. Begin
  1522.     Case SocketEvent of
  1523.       seConnect:ClientConnect(Socket);
  1524.       seDisconnect:ClientDisconnect(Socket);
  1525.       seDisconnected:ClientDisconnected(Socket);
  1526.       seRead:ClientRead(Socket);
  1527.       seWrite:ClientWrite(Socket);
  1528.     End;
  1529. End;
  1530.  
  1531. Procedure TServerWinSocket.ClientError(Sender: TObject; Socket: TCustomWinSocket;
  1532.                                        ErrorEvent: TErrorEvent;Var ErrorCode:Word);
  1533. Begin
  1534.      ClientErrorEvent(Socket, ErrorEvent, ErrorCode);
  1535. End;
  1536.  
  1537. Function TServerWinSocket.GetConnections(Index:LongInt):TCustomWinSocket;
  1538. Begin
  1539.     Result:=FConnections[Index];
  1540. End;
  1541.  
  1542. Function TServerWinSocket.GetActiveConnections:LongInt;
  1543. Begin
  1544.     Result:=FConnections.Count;
  1545. End;
  1546.  
  1547. Function TServerWinSocket.GetActiveThreads: LongInt;
  1548. Var
  1549.    t:LongInt;
  1550. Begin
  1551.     Result := 0;
  1552.     For t:=0 To FActiveThreads.Count-1 Do
  1553.       If TServerClientThread(FActiveThreads[t]).ClientSocket<>Nil Then
  1554.         Inc(Result);
  1555. End;
  1556.  
  1557. Function TServerWinSocket.GetIdleThreads: LongInt;
  1558. Var
  1559.    t:LongInt;
  1560. Begin
  1561.     Result := 0;
  1562.     For t:=0 To FActiveThreads.Count-1 Do
  1563.       If TServerClientThread(FActiveThreads[t]).ClientSocket=Nil Then
  1564.         Inc(Result);
  1565. End;
  1566.  
  1567. Procedure TServerWinSocket.Accept(Socket: TSocket);
  1568. Var
  1569.    ClientSocket: TServerClientWinSocket;
  1570.    ClientWinSocket: TSocket;
  1571.    Addr: TSockAddrIn;
  1572.    Len: LongInt;
  1573. Begin
  1574.     If WinSockHandle=0 Then exit;
  1575.     Len := SizeOf(TSockAddrIn);
  1576.     ClientWinSocket := WinSockProcs.accept(Socket, Addr, Len);
  1577.     If ClientWinSocket>0 Then
  1578.     Begin
  1579.          ClientSocket:=GetClientSocket(ClientWinSocket);
  1580.          If FOnSocketEvent<>Nil Then FOnSocketEvent(Self,ClientSocket,seAccept);
  1581.          If FServerType=stThreadBlocking Then
  1582.          Begin
  1583.              ClientSocket.ASyncStyles := [];
  1584.              GetServerThread(ClientSocket);
  1585.          End;
  1586.     End;
  1587. End;
  1588.  
  1589. Procedure TServerWinSocket.Listen(Var Name, Address, Service: String; Port: Word;
  1590.   QueueSize: LongInt);
  1591. Begin
  1592.   Inherited Listen(Name, Address, Service, Port, QueueSize);
  1593.   If FConnected Then If ServerType = stThreadBlocking Then
  1594.     FServerAcceptThread := TServerAcceptThread.Create(False, Self);
  1595. End;
  1596.  
  1597. Procedure TServerWinSocket.Disconnect(Socket: TSocket);
  1598. Var
  1599.   SaveCacheSize: LongInt;
  1600.   sc:TServerClientThread;
  1601.   cw:TCustomWinSocket;
  1602. Begin
  1603.     If not FConnected Then exit;
  1604.  
  1605.     SaveCacheSize := ThreadCacheSize;
  1606.  
  1607.     Try
  1608.         ThreadCacheSize := 0;
  1609.  
  1610.         While FActiveThreads.Count>0 Do
  1611.         Begin
  1612.              sc:=TServerClientThread(FActiveThreads.Last);
  1613.              sc.FreeOnTerminate := False;
  1614.              sc.Terminate;
  1615.              sc.FEvent.SetEvent;
  1616.              If sc.ClientSocket<>Nil Then If sc.ClientSocket.Connected Then sc.ClientSocket.Close;
  1617.              sc.WaitFor;
  1618.              sc.Destroy;
  1619.         End;
  1620.  
  1621.         While FConnections.Count>0 Do
  1622.         Begin
  1623.              cw:=TCustomWinSocket(FConnections.Last);
  1624.              cw.Destroy;
  1625.         End;
  1626.  
  1627.         If FServerAcceptThread <> nil Then FServerAcceptThread.Terminate;
  1628.         Inherited Disconnect(Socket);
  1629.         If FServerAcceptThread<>Nil Then
  1630.         Begin
  1631.             FServerAcceptThread.Destroy;
  1632.             FServerAcceptThread:=Nil;
  1633.         End;
  1634.     Finally
  1635.         ThreadCacheSize := SaveCacheSize;
  1636.     End;
  1637. End;
  1638.  
  1639. Function TServerWinSocket.DoCreateThread(ClientSocket: TServerClientWinSocket): TServerClientThread;
  1640. Begin
  1641.      Result := TServerClientThread.Create(False, ClientSocket);
  1642. End;
  1643.  
  1644. Procedure TServerWinSocket.ThreadStart(AThread: TServerClientThread);
  1645. Begin
  1646.      If FOnThreadStart<>Nil Then FOnThreadStart(Self,AThread);
  1647. End;
  1648.  
  1649. Procedure TServerWinSocket.ThreadEnd(AThread: TServerClientThread);
  1650. Begin
  1651.      If FOnThreadEnd<>Nil Then FOnThreadEnd(Self,AThread);
  1652. End;
  1653.  
  1654. Procedure TServerWinSocket.SetServerType(Value: TServerType);
  1655. Begin
  1656.      If Value=FServerType Then exit;
  1657.      If FConnected Then Raise ESocketError.Create('Cannot change socket while active');
  1658.  
  1659.      FServerType := Value;
  1660.      If FServerType=stThreadBlocking Then ASyncStyles := []
  1661.      Else ASyncStyles := [asAccept];
  1662. End;
  1663.  
  1664. Procedure TServerWinSocket.SetThreadCacheSize(Value: LongInt);
  1665. Var
  1666.    Start,t:LongInt;
  1667.    sc:TServerClientThread;
  1668. Begin
  1669.     If Value=FThreadCacheSize Then exit;
  1670.  
  1671.     If Value<FThreadCacheSize Then Start:=Value
  1672.     Else Start := FThreadCacheSize;
  1673.  
  1674.     FThreadCacheSize := Value;
  1675.  
  1676.     For t:=0 To FActiveThreads.Count-1 Do
  1677.     Begin
  1678.         sc:=TServerClientThread(FActiveThreads[t]);
  1679.         sc.KeepInCache:=t<Start;
  1680.     End;
  1681. End;
  1682.  
  1683. Function TServerWinSocket.GetClientSocket(Socket: TSocket): TServerClientWinSocket;
  1684. Begin
  1685.      Result:=Nil;
  1686.      If FOnGetSocket<>Nil Then FOnGetSocket(Self,Socket,Result);
  1687.      If Result=nil Then Result := TServerClientWinSocket.Create(Socket,Self);
  1688. End;
  1689.  
  1690. Function TServerWinSocket.GetServerThread(ClientSocket: TServerClientWinSocket): TServerClientThread;
  1691. Var
  1692.    t:LongInt;
  1693. Begin
  1694.      Result := Nil;
  1695.  
  1696.      For t:=0 To FActiveThreads.Count-1 Do
  1697.      Begin
  1698.           Result:=TServerClientThread(FActiveThreads[t]);
  1699.           If Result.ClientSocket=Nil Then
  1700.           Begin
  1701.               Result.ReActivate(ClientSocket);
  1702.               break;
  1703.           End;
  1704.      End;
  1705.  
  1706.      If FOnGetThread<>Nil Then FOnGetThread(Self,ClientSocket,Result);
  1707.      If Result=Nil Then Result:=DoCreateThread(ClientSocket);
  1708. End;
  1709.  
  1710. Function TServerWinSocket.GetClientThread(ClientSocket: TServerClientWinSocket): TServerClientThread;
  1711. Var
  1712.    t:LongInt;
  1713. Begin
  1714.      For t:=0 To FActiveThreads.Count-1 Do
  1715.      Begin
  1716.           Result:=TServerClientThread(FActiveThreads[t]);
  1717.           If Result.ClientSocket=ClientSocket Then exit;
  1718.      End;
  1719.      Result:=Nil;
  1720. End;
  1721.  
  1722. Procedure TServerWinSocket.ClientRead(Socket: TCustomWinSocket);
  1723. Begin
  1724.      If FOnClientRead<>Nil Then FOnClientRead(Self,Socket);
  1725. End;
  1726.  
  1727. Procedure TServerWinSocket.ClientWrite(Socket: TCustomWinSocket);
  1728. Begin
  1729.      If FOnClientWrite<>Nil Then FOnClientWrite(Self,Socket);
  1730. End;
  1731.  
  1732. Procedure TServerWinSocket.ClientConnect(Socket: TCustomWinSocket);
  1733. Begin
  1734.      If FOnClientConnect<>Nil Then FOnClientConnect(Self,Socket);
  1735. End;
  1736.  
  1737. Procedure TServerWinSocket.ClientDisconnect(Socket: TCustomWinSocket);
  1738. Begin
  1739.      If FOnClientDisconnect<>Nil Then FOnClientDisconnect(Self,Socket);
  1740. End;
  1741.  
  1742. Procedure TServerWinSocket.ClientDisconnected(Socket: TCustomWinSocket);
  1743. Begin
  1744.      If FOnClientDisconnected<>Nil Then FOnClientDisconnected(Self,Socket);
  1745.      If ServerType=stNonBlocking Then
  1746.       If Socket.FHandle<>0 Then PostMsg(Socket.FHandle,CM_DEFERFREE,0,0);
  1747. End;
  1748.  
  1749.  
  1750. Procedure TServerWinSocket.ClientErrorEvent(Socket: TCustomWinSocket;
  1751.                        ErrorEvent: TErrorEvent; Var ErrorCode:Word);
  1752. Begin
  1753.      If FOnClientError<>Nil Then FOnClientError(Self,Socket,ErrorEvent,ErrorCode);
  1754. End;
  1755.  
  1756. {
  1757. ╔═══════════════════════════════════════════════════════════════════════════╗
  1758. ║                                                                           ║
  1759. ║ Speed-Pascal/2 Version 2.0                                                ║
  1760. ║                                                                           ║
  1761. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  1762. ║                                                                           ║
  1763. ║ This section: TServerAcceptThread Class Implementation                    ║
  1764. ║                                                                           ║
  1765. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  1766. ║                                                                           ║
  1767. ╚═══════════════════════════════════════════════════════════════════════════╝
  1768. }
  1769.  
  1770.  
  1771. Constructor TServerAcceptThread.Create(CreateSuspended: Boolean;ASocket: TServerWinSocket);
  1772. Begin
  1773.      FServerSocket := ASocket;
  1774.      Inherited Create(CreateSuspended);
  1775. End;
  1776.  
  1777. Procedure TServerAcceptThread.Execute;
  1778. Begin
  1779.      While Not Terminated Do FServerSocket.Accept(FServerSocket.SocketHandle);
  1780. End;
  1781.  
  1782. {
  1783. ╔═══════════════════════════════════════════════════════════════════════════╗
  1784. ║                                                                           ║
  1785. ║ Speed-Pascal/2 Version 2.0                                                ║
  1786. ║                                                                           ║
  1787. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  1788. ║                                                                           ║
  1789. ║ This section: TServerClientThread Class Implementation                    ║
  1790. ║                                                                           ║
  1791. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  1792. ║                                                                           ║
  1793. ╚═══════════════════════════════════════════════════════════════════════════╝
  1794. }
  1795.  
  1796.  
  1797. Constructor TServerClientThread.Create(CreateSuspended:Boolean;
  1798.                                        ASocket:TServerClientWinSocket);
  1799. Begin
  1800.      FreeOnTerminate := True;
  1801.      FEvent:=TSimpleEvent.Create;
  1802.      Inherited Create(True);
  1803.      Priority:=tpHigher;
  1804.      ReActivate(ASocket);
  1805.      If not CreateSuspended Then Resume;
  1806. End;
  1807.  
  1808. Destructor TServerClientThread.Destroy;
  1809. Begin
  1810.      FClientSocket.Destroy;
  1811.      FEvent.Destroy;
  1812.      Inherited Destroy;
  1813. End;
  1814.  
  1815. Procedure TServerClientThread.Execute;
  1816. Begin
  1817.      FServerSocket.ThreadStart(Self);
  1818.      Try
  1819.         Try
  1820.            While True Do
  1821.            Begin
  1822.                If StartConnect Then ClientExecute;
  1823.                If EndConnect Then Break;
  1824.            End;
  1825.         Except
  1826.            On e:Exception Do
  1827.            Begin
  1828.                 HandleException(e);
  1829.                 KeepInCache := False;
  1830.            End;
  1831.         End;
  1832.      Finally
  1833.         FServerSocket.ThreadEnd(Self);
  1834.      End;
  1835. End;
  1836.  
  1837. Function TServerClientThread.StartConnect:Boolean;
  1838. Begin
  1839.      If FEvent.WaitFor(INFINITE) = wrSignaled Then FEvent.ResetEvent;
  1840.      Result := not Terminated;
  1841. End;
  1842.  
  1843. Function TServerClientThread.EndConnect: Boolean;
  1844. Begin
  1845.      FClientSocket.Destroy;
  1846.      FClientSocket := nil;
  1847.      Result:=Terminated or Not KeepInCache;
  1848. End;
  1849.  
  1850. Procedure TServerClientThread.ReActivate(ASocket: TServerClientWinSocket);
  1851. Begin
  1852.      FClientSocket := ASocket;
  1853.      If FClientSocket<>Nil Then
  1854.      Begin
  1855.          FServerSocket := FClientSocket.ServerWinSocket;
  1856.          If FServerSocket.FActiveThreads.IndexOf(Self)<0 Then
  1857.          Begin
  1858.               FServerSocket.FActiveThreads.Add(Self);
  1859.               If FServerSocket.FActiveThreads.Count<=FServerSocket.FThreadCacheSize Then
  1860.                 KeepInCache:=True;
  1861.          End;
  1862.          FClientSocket.OnErrorEvent:=HandleError;
  1863.          FClientSocket.OnSocketEvent:=HandleEvent;
  1864.          FEvent.SetEvent;
  1865.      End;
  1866. End;
  1867.  
  1868. Procedure TServerClientThread.DoHandleException;
  1869. Begin
  1870.      {$IFDEF OS2}
  1871.      WinSetCapture(HWND_DESKTOP,0);
  1872.      {$ENDIF}
  1873.      If FException Is Exception Then Application.ShowException(FException)
  1874.      Else Raise FException;
  1875. End;
  1876.  
  1877. Procedure TServerClientThread.HandleException(e:Exception);
  1878. Begin
  1879.      FException := e;
  1880.      Try
  1881.         Synchronize(DoHandleException);
  1882.      Finally
  1883.         FException := nil;
  1884.      End;
  1885. End;
  1886.  
  1887.  
  1888. Procedure TServerClientThread.DoRead;
  1889. Begin
  1890.      ClientSocket.ServerWinSocket.Event(ClientSocket,seRead);
  1891. End;
  1892.  
  1893. Procedure TServerClientThread.DoWrite;
  1894. Begin
  1895.      FServerSocket.Event(ClientSocket, seWrite);
  1896. End;
  1897.  
  1898. Procedure TServerClientThread.DoTerminate;
  1899. Begin
  1900.      If FServerSocket<>Nil Then
  1901.      Begin
  1902.           If FServerSocket.FActiveThreads.IndexOf(Self)>=0 Then
  1903.             FServerSocket.FActiveThreads.Remove(Self);
  1904.      End;
  1905. End;
  1906.  
  1907. Procedure TServerClientThread.HandleEvent(Sender:TObject;Socket:TCustomWinSocket;
  1908.                                           SocketEvent:TSocketEvent);
  1909. Begin
  1910.      Event(SocketEvent);
  1911. End;
  1912.  
  1913. Procedure TServerClientThread.Event(SocketEvent: TSocketEvent);
  1914. Begin
  1915.      FServerSocket.ClientEvent(Self,ClientSocket,SocketEvent);
  1916. End;
  1917.  
  1918. Procedure TServerClientThread.HandleError(Sender:TObject;Socket:TCustomWinSocket;
  1919.                                           ErrorEvent:TErrorEvent;Var ErrorCode:Word);
  1920. Begin
  1921.      Error(ErrorEvent, ErrorCode);
  1922. End;
  1923.  
  1924.  
  1925. Procedure TServerClientThread.Error(ErrorEvent:TErrorEvent;Var ErrorCode:Word);
  1926. Begin
  1927.      FServerSocket.ClientError(Self, ClientSocket, ErrorEvent, ErrorCode);
  1928. End;
  1929.  
  1930. Const FD_SETSIZE      = 64;
  1931.  
  1932. Type TFDSET=Record
  1933.                 fd_count:Word;
  1934.                 fd_array:Array[0..FD_SETSIZE-1] Of TSOCKET;
  1935.      End;
  1936.  
  1937.      timeval=Record
  1938.                 tv_sec:LongInt;
  1939.                 tv_usec:LongInt;
  1940.      End;
  1941.  
  1942. Procedure FD_ZERO(Var aset:TFDSET);
  1943. Begin
  1944.     aset.fd_count:=0;
  1945. End;
  1946.  
  1947. Procedure FD_SET(Socket:TSocket;Var FDSet:TFDSet);
  1948. Begin
  1949.   If FDSet.fd_count < FD_SETSIZE Then
  1950.   Begin
  1951.     FDSet.fd_array[FDSet.fd_count]:=Socket;
  1952.     Inc(FDSet.fd_count);
  1953.   End;
  1954. End;
  1955.  
  1956. Procedure TServerClientThread.ClientExecute;
  1957. Var
  1958.    FDSet: TFDSet;
  1959.    aTimeVal: TimeVal;
  1960. Begin
  1961.      If WinSockHandle=0 Then exit;
  1962.      While not Terminated And ClientSocket.Connected Do
  1963.      Begin
  1964.           FD_ZERO(FDSet);
  1965.           FD_SET(ClientSocket.SocketHandle, FDSet);
  1966.           aTimeVal.tv_sec := 0;
  1967.           aTimeVal.tv_usec := 500;
  1968.           If (WinSockProcs.select(0, FDSet, nil, nil, aTimeVal) > 0) and not Terminated Then
  1969.             If ClientSocket.ReceiveBuf(FDSet, -1) = 0 Then Break
  1970.           Else Synchronize(DoRead);
  1971.           If WinSockProcs.select(0, nil, FDSet, nil, aTimeVal) > 0 Then
  1972.             If not Terminated Then Synchronize(DoWrite);
  1973.      End; //While
  1974. End;
  1975.  
  1976. {
  1977. ╔═══════════════════════════════════════════════════════════════════════════╗
  1978. ║                                                                           ║
  1979. ║ Speed-Pascal/2 Version 2.0                                                ║
  1980. ║                                                                           ║
  1981. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  1982. ║                                                                           ║
  1983. ║ This section: TCustomSocket Class Implementation                          ║
  1984. ║                                                                           ║
  1985. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  1986. ║                                                                           ║
  1987. ╚═══════════════════════════════════════════════════════════════════════════╝
  1988. }
  1989.  
  1990. Procedure TCustomSocket.Open;
  1991. Begin
  1992.      Active := True;
  1993. End;
  1994.  
  1995. Procedure TCustomSocket.Close;
  1996. Begin
  1997.      Active := False;
  1998. End;
  1999.  
  2000. Procedure TCustomSocket.SetActive(Value: Boolean);
  2001. Var InsideDesigner:Boolean;
  2002. Begin
  2003.   If Value<>FActive Then
  2004.   Begin
  2005.       FActive := Value;
  2006.       Asm
  2007.          MOV AL,Classes.InsideDesigner
  2008.          MOV InsideDesigner,AL
  2009.       End;
  2010.       If ((not (csLoading In ComponentState))And(not InsideDesigner)) Then
  2011.          DoActivate(Value);
  2012.   End;
  2013. End;
  2014.  
  2015. Procedure TCustomSocket.DoEvent(Sender:TObject;Socket:TCustomWinSocket;
  2016.                                 SocketEvent:TSocketEvent);
  2017. Begin
  2018.      Event(Socket,SocketEvent);
  2019. End;
  2020.  
  2021. Procedure TCustomSocket.DoError(Sender:TObject;Socket:TCustomWinSocket;
  2022.                                 ErrorEvent:TErrorEvent;Var ErrorCode:Word);
  2023. Begin
  2024.      Error(Socket,ErrorEvent,ErrorCode);
  2025. End;
  2026.  
  2027. Procedure TCustomSocket.Event(Socket: TCustomWinSocket; SocketEvent: TSocketEvent);
  2028. Begin
  2029.      Case SocketEvent Of
  2030.          seRead:If FOnRead<>Nil Then FOnRead(Self, Socket);
  2031.          seWrite:If FOnWrite<>Nil Then FOnWrite(Self, Socket);
  2032.          seLookup: If Assigned(FOnLookup) Then FOnLookup(Self, Socket);
  2033.          seAccept:If FOnAccept<>Nil Then FOnAccept(Self,Socket);
  2034.          seConnecting:If FOnConnecting<>Nil Then FOnConnecting(Self,Socket);
  2035.          seConnect:
  2036.          Begin
  2037.               FActive := True;
  2038.               If FOnConnect<>Nil Then FOnConnect(Self,Socket);
  2039.          End;
  2040.          seDisconnect:
  2041.          Begin
  2042.               FActive := False;
  2043.               If FOnDisconnect<>Nil Then FOnDisconnect(Self,Socket);
  2044.          End;
  2045.          seListen:
  2046.          Begin
  2047.               FActive := True;
  2048.               If FOnListen<>Nil Then FOnListen(Self,Socket);
  2049.          End;
  2050.      End; //case
  2051. End;
  2052.  
  2053. Procedure TCustomSocket.Error(Socket:TCustomWinSocket;ErrorEvent:TErrorEvent;
  2054.                               Var ErrorCode:Word);
  2055. Begin
  2056.      If FOnError<>Nil Then FOnError(Self,Socket,ErrorEvent,ErrorCode);
  2057. End;
  2058.  
  2059. Procedure TCustomSocket.Loaded;
  2060. Var InsideDesigner:Boolean;
  2061. Begin
  2062.     Inherited Loaded;
  2063.     Asm
  2064.        MOV AL,Classes.InsideDesigner
  2065.        MOV InsideDesigner,AL
  2066.     End;
  2067.     If not InsideDesigner Then DoActivate(FActive);
  2068. End;
  2069.  
  2070. Procedure TCustomSocket.SetService(Value: String);
  2071. Begin
  2072.     If CompareText(Value,FService)=0 Then exit;
  2073.  
  2074.     If not (csLoading in ComponentState) and FActive Then
  2075.       raise ESocketError.Create('Cannot change socket while active');
  2076.     FService := Value;
  2077. End;
  2078.  
  2079. Procedure TCustomSocket.SetHost(Value: String);
  2080. Begin
  2081.     If CompareText(Value,FHost)=0 Then exit;
  2082.  
  2083.     If not (csLoading in ComponentState) and FActive Then
  2084.       raise ESocketError.Create('Cannot change socket while active');
  2085.     FHost := Value;
  2086. End;
  2087.  
  2088. Procedure TCustomSocket.SetAddress(Value: String);
  2089. Begin
  2090.     If CompareText(Value,FAddress)=0 Then exit;
  2091.  
  2092.     If not (csLoading in ComponentState) and FActive Then
  2093.       Raise ESocketError.Create('Cannot change socket while active');
  2094.     FAddress := Value;
  2095. End;
  2096.  
  2097. Procedure TCustomSocket.SetPort(Value: LongInt);
  2098. Begin
  2099.     If FPort=Value Then exit;
  2100.  
  2101.     If not (csLoading in ComponentState) and FActive Then
  2102.       raise ESocketError.Create('Cannot change socket while active');
  2103.     FPort := Value;
  2104. End;
  2105.  
  2106. {
  2107. ╔═══════════════════════════════════════════════════════════════════════════╗
  2108. ║                                                                           ║
  2109. ║ Speed-Pascal/2 Version 2.0                                                ║
  2110. ║                                                                           ║
  2111. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2112. ║                                                                           ║
  2113. ║ This section: TWinSocketStream Class Implementation                       ║
  2114. ║                                                                           ║
  2115. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2116. ║                                                                           ║
  2117. ╚═══════════════════════════════════════════════════════════════════════════╝
  2118. }
  2119.  
  2120.  
  2121. Constructor TWinSocketStream.Create(ASocket: TCustomWinSocket; TimeOut: Longint);
  2122. Begin
  2123.      If ASocket.ASyncStyles <> [] Then Raise ESocketError.Create('Socket must be blocking');
  2124.      FSocket := ASocket;
  2125.      FTimeOut := TimeOut;
  2126.      FEvent.Create;
  2127.      Inherited Create;
  2128. End;
  2129.  
  2130. Destructor TWinSocketStream.Destroy;
  2131. Begin
  2132.     FEvent.Destroy;
  2133.     Inherited Destroy;
  2134. End;
  2135.  
  2136. Function TWinSocketStream.Read(Var Buffer;Count:Longint): Longint;
  2137. Begin
  2138.     Result:=0;
  2139.     If WinSockHandle=0 Then exit;
  2140.     result:=WinSockProcs.recv(FSocket.SocketHandle,Buffer,Count,0);
  2141.     If FEvent.WaitFor(FTimeOut)<>wrSignaled Then Result:=0
  2142.     Else FEvent.ResetEvent;
  2143. End;
  2144.  
  2145. Function TWinSocketStream.Write(Const Buffer; Count: Longint): Longint;
  2146. Begin
  2147.     Result:=0;
  2148.     If WinSockHandle=0 Then exit;
  2149.     result:=WinSockProcs.send(FSocket.SocketHandle,Buffer,Count,0);
  2150.     If FEvent.WaitFor(FTimeOut)<>wrSignaled Then Result:=0
  2151.     Else FEvent.ResetEvent;
  2152. End;
  2153.  
  2154. Function TWinSocketStream.WaitForData(Timeout: Longint): Boolean;
  2155. Var
  2156.   FDSet: TFDSet;
  2157.   aTimeVal: TimeVal;
  2158. Begin
  2159.     Result:=False;
  2160.     If WinSockHandle=0 Then exit;
  2161.     aTimeVal.tv_sec:=Timeout Div 1000;
  2162.     aTimeVal.tv_usec:=(Timeout Mod 1000)*1000;
  2163.     FD_ZERO(FDSet);
  2164.     FD_SET(FSocket.SocketHandle, FDSet);
  2165.     Result:=WinSockProcs.select(0,FDSet,Nil,Nil,aTimeVal)>0;
  2166. End;
  2167.  
  2168. Function TWinSocketStream.Seek(Offset: Longint; Origin: Word): Longint;
  2169. Begin
  2170.      Result := 0;
  2171. End;
  2172.  
  2173. {
  2174. ╔═══════════════════════════════════════════════════════════════════════════╗
  2175. ║                                                                           ║
  2176. ║ Speed-Pascal/2 Version 2.0                                                ║
  2177. ║                                                                           ║
  2178. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2179. ║                                                                           ║
  2180. ║ This section: TClientSocket Class Implementation                          ║
  2181. ║                                                                           ║
  2182. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2183. ║                                                                           ║
  2184. ╚═══════════════════════════════════════════════════════════════════════════╝
  2185. }
  2186.  
  2187.  
  2188. Constructor TClientSocket.Create(AOwner:TComponent);
  2189. Begin
  2190.      Inherited Create(AOwner);
  2191.      FClientSocket.Create(INVALID_SOCKET);
  2192.      FClientSocket.OnSocketEvent:=DoEvent;
  2193.      FClientSocket.OnErrorEvent:=DoError;
  2194. End;
  2195.  
  2196. Destructor TClientSocket.Destroy;
  2197. Begin
  2198.      FClientSocket.Destroy;
  2199.      Inherited Destroy;
  2200. End;
  2201.  
  2202. Procedure TClientSocket.DoActivate(Value: Boolean);
  2203. Begin
  2204.     If FClientSocket.Connected=Value Then exit;
  2205.     If csDesigning In ComponentState Then exit;
  2206.  
  2207.     If ((Value=False)And(FClientSocket.Connected)) Then FClientSocket.Disconnect(FClientSocket.FSocket)
  2208.     Else If Value Then FClientSocket.Open(FHost,FAddress,FService,FPort);
  2209. End;
  2210.  
  2211. Function TClientSocket.GetClientType: TClientType;
  2212. Begin
  2213.     Result := FClientSocket.ClientType;
  2214. End;
  2215.  
  2216. Procedure TClientSocket.SetClientType(Value: TClientType);
  2217. Begin
  2218.     FClientSocket.ClientType := Value;
  2219. End;
  2220.  
  2221. {
  2222. ╔═══════════════════════════════════════════════════════════════════════════╗
  2223. ║                                                                           ║
  2224. ║ Speed-Pascal/2 Version 2.0                                                ║
  2225. ║                                                                           ║
  2226. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  2227. ║                                                                           ║
  2228. ║ This section: TServerSocket Class Implementation                          ║
  2229. ║                                                                           ║
  2230. ║ (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited !       ║
  2231. ║                                                                           ║
  2232. ╚═══════════════════════════════════════════════════════════════════════════╝
  2233. }
  2234.  
  2235. Constructor TServerSocket.Create(AOwner: TComponent);
  2236. Begin
  2237.     Inherited Create(AOwner);
  2238.     FServerSocket.Create(INVALID_SOCKET);
  2239.     FServerSocket.OnSocketEvent:=DoEvent;
  2240.     FServerSocket.OnErrorEvent:=DoError;
  2241.     FServerSocket.ThreadCacheSize:=10;
  2242. End;
  2243.  
  2244. Destructor TServerSocket.Destroy;
  2245. Begin
  2246.      FServerSocket.Destroy;
  2247.      Inherited Destroy;
  2248. End;
  2249.  
  2250. Function TServerSocket.GetServerType: TServerType;
  2251. Begin
  2252.     Result:=FServerSocket.ServerType;
  2253. End;
  2254.  
  2255. Procedure TServerSocket.SetServerType(Value: TServerType);
  2256. Begin
  2257.     FServerSocket.ServerType:=Value;
  2258. End;
  2259.  
  2260. Function TServerSocket.GetGetThreadEvent: TGetThreadEvent;
  2261. Begin
  2262.     Result:=FServerSocket.OnGetThread;
  2263. End;
  2264.  
  2265. Procedure TServerSocket.SetGetThreadEvent(Value: TGetThreadEvent);
  2266. Begin
  2267.     FServerSocket.OnGetThread:=Value;
  2268. End;
  2269.  
  2270. Function TServerSocket.GetGetSocketEvent: TGetSocketEvent;
  2271. Begin
  2272.     Result:=FServerSocket.OnGetSocket;
  2273. End;
  2274.  
  2275. Procedure TServerSocket.SetGetSocketEvent(Value:TGetSocketEvent);
  2276. Begin
  2277.     FServerSocket.OnGetSocket:=Value;
  2278. End;
  2279.  
  2280. Function TServerSocket.GetThreadCacheSize:LongInt;
  2281. Begin
  2282.     Result:=FServerSocket.ThreadCacheSize;
  2283. End;
  2284.  
  2285. Procedure TServerSocket.SetThreadCacheSize(Value:LongInt);
  2286. Begin
  2287.     FServerSocket.ThreadCacheSize:=Value;
  2288. End;
  2289.  
  2290. Function TServerSocket.GetOnThreadStart:TThreadNotifyEvent;
  2291. Begin
  2292.     Result:=FServerSocket.OnThreadStart;
  2293. End;
  2294.  
  2295. Function TServerSocket.GetOnThreadEnd:TThreadNotifyEvent;
  2296. Begin
  2297.     Result:=FServerSocket.OnThreadEnd;
  2298. End;
  2299.  
  2300. Procedure TServerSocket.SetOnThreadStart(Value:TThreadNotifyEvent);
  2301. Begin
  2302.     FServerSocket.OnThreadStart:=Value;
  2303. End;
  2304.  
  2305. Procedure TServerSocket.SetOnThreadEnd(Value:TThreadNotifyEvent);
  2306. Begin
  2307.     FServerSocket.OnThreadEnd:=Value;
  2308. End;
  2309.  
  2310. Function TServerSocket.GetOnClientConnect:TSocketNotifyEvent;
  2311. Begin
  2312.     Result:=FServerSocket.OnClientConnect;
  2313. End;
  2314.  
  2315. Procedure TServerSocket.SetOnClientConnect(Value:TSocketNotifyEvent);
  2316. Begin
  2317.     FServerSocket.OnClientConnect:=Value;
  2318. End;
  2319.  
  2320. Function TServerSocket.GetOnClientDisconnect:TSocketNotifyEvent;
  2321. Begin
  2322.     Result:=FServerSocket.OnClientDisconnect;
  2323. End;
  2324.  
  2325. Function TServerSocket.GetOnClientDisconnected:TSocketNotifyEvent;
  2326. Begin
  2327.     Result:=FServerSocket.OnClientDisconnected;
  2328. End;
  2329.  
  2330.  
  2331. Procedure TServerSocket.SetOnClientDisconnect(Value:TSocketNotifyEvent);
  2332. Begin
  2333.     FServerSocket.OnClientDisconnect:=Value;
  2334. End;
  2335.  
  2336. Procedure TServerSocket.SetOnClientDisconnected(Value:TSocketNotifyEvent);
  2337. Begin
  2338.     FServerSocket.OnClientDisconnected:=Value;
  2339. End;
  2340.  
  2341.  
  2342. Function TServerSocket.GetOnClientRead: TSocketNotifyEvent;
  2343. Begin
  2344.     Result:=FServerSocket.OnClientRead;
  2345. End;
  2346.  
  2347. Procedure TServerSocket.SetOnClientRead(Value:TSocketNotifyEvent);
  2348. Begin
  2349.     FServerSocket.OnClientRead:=Value;
  2350. End;
  2351.  
  2352. Function TServerSocket.GetOnClientWrite:TSocketNotifyEvent;
  2353. Begin
  2354.     Result:=FServerSocket.OnClientWrite;
  2355. End;
  2356.  
  2357. Procedure TServerSocket.SetOnClientWrite(Value:TSocketNotifyEvent);
  2358. Begin
  2359.     FServerSocket.OnClientWrite:=Value;
  2360. End;
  2361.  
  2362. Function TServerSocket.GetOnClientError:TSocketErrorEvent;
  2363. Begin
  2364.     Result:=FServerSocket.OnClientError;
  2365. End;
  2366.  
  2367. Procedure TServerSocket.SetOnClientError(Value:TSocketErrorEvent);
  2368. Begin
  2369.     FServerSocket.OnClientError:=Value;
  2370. End;
  2371.  
  2372. Procedure TServerSocket.DoActivate(Value: Boolean);
  2373. Begin
  2374.     If Value=FServerSocket.Connected Then exit;
  2375.     If csDesigning In ComponentState Then exit;
  2376.  
  2377.     If ((Value=False)And(FServerSocket.Connected)) Then FServerSocket.Disconnect(FServerSocket.SocketHandle)
  2378.     Else If Value Then FServerSocket.Listen(FHost,FAddress,FService,FPort,5);
  2379. End;
  2380.  
  2381. Begin
  2382.     RegisterClasses([TClientSocket,TServerSocket]);
  2383. End.
  2384.  
  2385.