home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / chap11 / howto04 / delphi10 / ccwsock.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1996-01-23  |  58.7 KB  |  1,417 lines
  1. unit Ccwsock;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs;
  8. const
  9.   { This is the base message used by Winsock to notify of Winsock asynch act }
  10.   WM_ASYNCSELECT = WM_USER + 0;
  11.   { These are miscellaneous constants which might be needed by an app }
  12.   FD_SETSIZE                   = 64;        { ??? }
  13.   INADDR_ANY         : longint = 0;         { Winsock any IP address constant }
  14.   INADDR_NONE        : longint = -1;        { Winsock no IP address constant }
  15.   INADDR_LOOPBACK    : longint = $7f000001; { This corresponds to 127.0.0.1 }
  16.   WSADESCRIPTION_LEN           = 256;       { Winsock defined vendor desc }
  17.   WSASYS_STATUS_LEN            = 128;       { Winsock defined status info }
  18.   { These are IP Protocols Standard values from Winsock ( more or less ) }
  19.   IPPROTO_IP         =  0;              { dummy for IP }
  20.   IPPROTO_ICMP       =  1;              { control message protocol }
  21.   IPPROTO_GGP        =  2;              { gateway^2 (deprecated) }
  22.   IPPROTO_TCP        =  6;              { tcp }
  23.   IPPROTO_PUP        =  12;             { pup }
  24.   IPPROTO_UDP        =  17;             { user datagram protocol }
  25.   IPPROTO_IDP        =  22;             { xns idp }
  26.   IPPROTO_ND         =  77;             { UNOFFICIAL net disk proto }
  27.   IPPROTO_RAW        = 255;             { raw IP packet }
  28.   IPPROTO_MAX        = 256;
  29.   { These are "well known" Port/socket numbers for client functions }
  30.   IPPORT_ECHO        =     7;
  31.   IPPORT_DISCARD     =     9;
  32.   IPPORT_SYSTAT      =     11;
  33.   IPPORT_DAYTIME     =     13;
  34.   IPPORT_NETSTAT     =     15;
  35.   IPPORT_FTP         =     21;  { FTP Default }
  36.   IPPORT_TELNET      =     23;  { Telnet Default }
  37.   IPPORT_SMTP        =     25;  { SMTP Default }
  38.   IPPORT_TIMESERVER  =     37;
  39.   IPPORT_NAMESERVER  =     42;
  40.   IPPORT_WHOIS       =     43;
  41.   IPPORT_MTP         =     57;
  42.   { These are "well known" Port/socket numbers for host specific functions }
  43.   IPPORT_TFTP        =     69;
  44.   IPPORT_RJE         =     77;
  45.   IPPORT_FINGER      =     79; { Finger Default }
  46.   IPPORT_TTYLINK     =     87;
  47.   IPPORT_SUPDUP      =     95;
  48.   { These are "well known" UNIX TCP sockets }
  49.   IPPORT_EXECSERVER  =     512;
  50.   IPPORT_LOGINSERVER =     513;
  51.   IPPORT_CMDSERVER   =     514;
  52.   IPPORT_EFSSERVER   =     520;
  53.   { These are "well known" UNIX UDP sockets }
  54.   IPPORT_BIFFUDP     =     512;
  55.   IPPORT_WHOSERVER   =     513;
  56.   IPPORT_ROUTESERVER =     520;
  57.   { Reserved Port number base }
  58.   IPPORT_RESERVED    =     1024;
  59.   { Link numbers (Which I don't know what are, either... :) }
  60.   IMPLINK_IP         =     155;
  61.   IMPLINK_LOWEXPER   =     156;
  62.   IMPLINK_HIGHEXPER  =     158;
  63.   { Winsock constants }
  64.   INVALID_SOCKET     =     $ffff;
  65.   SOCKET_ERROR       =     (-1);
  66.   { Socket Types; STREAM is the only one normally used }
  67.   SOCK_STREAM        =  1;              { stream socket }
  68.   SOCK_DGRAM         =  2;              { datagram socket }
  69.   SOCK_RAW           =  3;              { raw-protocol interface }
  70.   SOCK_RDM           =  4;              { reliably-delivered message }
  71.   SOCK_SEQPACKET     =  5;              { sequenced packet stream }
  72.   { Individual Socket Option flags }
  73.   SO_DEBUG           =  $0001;         { turn on debugging info recording }
  74.   SO_ACCEPTCONN      =  $0002;         { socket has had listen() }
  75.   SO_REUSEADDR       =  $0004;         { allow local address reuse }
  76.   SO_KEEPALIVE       =  $0008;         { keep connections alive }
  77.   SO_DONTROUTE       =  $0010;         { just use interface addresses }
  78.   SO_BROADCAST       =  $0020;         { permit sending of broadcast msgs }
  79.   SO_USELOOPBACK     =  $0040;         { bypass hardware when possible }
  80.   SO_LINGER          =  $0080;         { linger on close if data present }
  81.   SO_OOBINLINE       =  $0100;         { leave received OOB data in line }
  82.   SO_DONTLINGER      = (not SO_LINGER);
  83.   SO_SNDBUF          =  $1001;         { send buffer size }
  84.   SO_RCVBUF          =  $1002;         { receive buffer size }
  85.   SO_SNDLOWAT        =  $1003;         { send low-water mark }
  86.   SO_RCVLOWAT        =  $1004;         { receive low-water mark }
  87.   SO_SNDTIMEO        =  $1005;         { send timeout }
  88.   SO_RCVTIMEO        =  $1006;         { receive timeout }
  89.   SO_ERROR           =  $1007;         { get error status and clear }
  90.   SO_TYPE            =  $1008;         { get socket type }
  91.   { TCP global options }
  92.   TCP_NODELAY        =  $0001;
  93.   { IP Address families }
  94.   AF_UNSPEC          =  0;              { unspecified }
  95.   AF_UNIX            =  1;              { local to host (pipes, portals) }
  96.   AF_INET            =  2;              { internetwork: UDP, TCP, etc. }
  97.   AF_IMPLINK         =  3;              { arpanet imp addresses }
  98.   AF_PUP             =  4;              { pup protocols: e.g. BSP }
  99.   AF_CHAOS           =  5;              { mit CHAOS protocols }
  100.   AF_NS              =  6;              { XEROX NS protocols }
  101.   AF_ISO             =  7;              { ISO protocols }
  102.   AF_OSI             =  AF_ISO;         { OSI is ISO }
  103.   AF_ECMA            =  8;              { european computer manufacturers }
  104.   AF_DATAKIT         =  9;              { datakit protocols }
  105.   AF_CCITT           =  10;             { CCITT protocols, X.25 etc }
  106.   AF_SNA             =  11;             { IBM SNA }
  107.   AF_DECnet          =  12;             { DECnet }
  108.   AF_DLI             =  13;             { Direct data link interface }
  109.   AF_LAT             =  14;             { LAT }
  110.   AF_HYLINK          =  15;             { NSC Hyperchannel }
  111.   AF_APPLETALK       =  16;             { AppleTalk }
  112.   AF_NETBIOS         =  17;             { NetBios-style addresses }
  113.   AF_MAX             =  18;
  114.   { IP Protocol families, same as address families for now }
  115.   PF_UNSPEC          =  AF_UNSPEC;
  116.   PF_UNIX            =  AF_UNIX;
  117.   PF_INET            =  AF_INET;
  118.   PF_IMPLINK         =  AF_IMPLINK;
  119.   PF_PUP             =  AF_PUP;
  120.   PF_CHAOS           =  AF_CHAOS;
  121.   PF_NS              =  AF_NS;
  122.   PF_ISO             =  AF_ISO;
  123.   PF_OSI             =  AF_OSI;
  124.   PF_ECMA            =  AF_ECMA;
  125.   PF_DATAKIT         =  AF_DATAKIT;
  126.   PF_CCITT           =  AF_CCITT;
  127.   PF_SNA             =  AF_SNA;
  128.   PF_DECnet          =  AF_DECnet;
  129.   PF_DLI             =  AF_DLI;
  130.   PF_LAT             =  AF_LAT;
  131.   PF_HYLINK          =  AF_HYLINK;
  132.   PF_APPLETALK       =  AF_APPLETALK;
  133.   PF_MAX             =  AF_MAX;
  134.  { Level number for (get/set)sockopt() to apply to socket itself }
  135.  SOL_SOCKET          = -1;          { options for socket level }
  136.  { Maximum queue length specifiable by listen }
  137.  SOMAXCONN     =   5;
  138.  MSG_OOB       =  $1;             { process out-of-band data }
  139.  MSG_PEEK      =  $2;             { peek at incoming message }
  140.  MSG_DONTROUTE =  $4;             { send without using routing tables }
  141.  MSG_MAXIOVLEN =  16;
  142.  { Define constant based on rfc883, used by gethostbyxxxx() calls }
  143.  MAXGETHOSTSTRUCT   =     1024;
  144.  { Define flags to be used with the WSAAsyncSelect() call }
  145.  FD_READ       =  $01;
  146.  FD_WRITE      =  $02;
  147.  FD_OOB        =  $04;
  148.  FD_ACCEPT     =  $08;
  149.  FD_CONNECT    =  $10;
  150.  FD_CLOSE      =  $20;
  151.  { All Windows Sockets error constants are biased by WSABASEERR from the norm }
  152.  WSABASEERR    =          10000;
  153.  { Windows Sockets definitions of regular Microsoft C error constants }
  154.  WSAEINTR      =          (WSABASEERR+4);
  155.  WSAEBADF      =          (WSABASEERR+9);
  156.  WSAEACCES     =          (WSABASEERR+13);
  157.  WSAEFAULT     =          (WSABASEERR+14);
  158.  WSAEINVAL     =          (WSABASEERR+22);
  159.  WSAEMFILE     =          (WSABASEERR+24);
  160.  { Windows Sockets definitions of regular Berkeley error constants }
  161.  WSAEWOULDBLOCK      =    (WSABASEERR+35);
  162.  WSAEINPROGRESS      =    (WSABASEERR+36);
  163.  WSAEALREADY         =    (WSABASEERR+37);
  164.  WSAENOTSOCK         =    (WSABASEERR+38);
  165.  WSAEDESTADDRREQ     =    (WSABASEERR+39);
  166.  WSAEMSGSIZE         =    (WSABASEERR+40);
  167.  WSAEPROTOTYPE       =    (WSABASEERR+41);
  168.  WSAENOPROTOOPT      =    (WSABASEERR+42);
  169.  WSAEPROTONOSUPPORT  =    (WSABASEERR+43);
  170.  WSAESOCKTNOSUPPORT  =    (WSABASEERR+44);
  171.  WSAEOPNOTSUPP       =    (WSABASEERR+45);
  172.  WSAEPFNOSUPPORT     =    (WSABASEERR+46);
  173.  WSAEAFNOSUPPORT     =    (WSABASEERR+47);
  174.  WSAEADDRINUSE       =    (WSABASEERR+48);
  175.  WSAEADDRNOTAVAIL    =    (WSABASEERR+49);
  176.  WSAENETDOWN         =    (WSABASEERR+50);
  177.  WSAENETUNREACH      =    (WSABASEERR+51);
  178.  WSAENETRESET        =    (WSABASEERR+52);
  179.  WSAECONNABORTED     =    (WSABASEERR+53);
  180.  WSAECONNRESET       =    (WSABASEERR+54);
  181.  WSAENOBUFS          =    (WSABASEERR+55);
  182.  WSAEISCONN          =    (WSABASEERR+56);
  183.  WSAENOTCONN         =    (WSABASEERR+57);
  184.  WSAESHUTDOWN        =    (WSABASEERR+58);
  185.  WSAETOOMANYREFS     =    (WSABASEERR+59);
  186.  WSAETIMEDOUT        =    (WSABASEERR+60);
  187.  WSAECONNREFUSED     =    (WSABASEERR+61);
  188.  WSAELOOP            =    (WSABASEERR+62);
  189.  WSAENAMETOOLONG     =    (WSABASEERR+63);
  190.  WSAEHOSTDOWN        =    (WSABASEERR+64);
  191.  WSAEHOSTUNREACH     =    (WSABASEERR+65);
  192.  WSAENOTEMPTY        =    (WSABASEERR+66);
  193.  WSAEPROCLIM         =    (WSABASEERR+67);
  194.  WSAEUSERS           =    (WSABASEERR+68);
  195.  WSAEDQUOT           =    (WSABASEERR+69);
  196.  WSAESTALE           =    (WSABASEERR+70);
  197.  WSAEREMOTE          =    (WSABASEERR+71);
  198.  { Extended Windows Sockets error constant definitions }
  199.  WSASYSNOTREADY      =    (WSABASEERR+91);
  200.  WSAVERNOTSUPPORTED  =    (WSABASEERR+92);
  201.  WSANOTINITIALISED   =    (WSABASEERR+93);
  202.  { Authoritative Answer: Host not found }
  203.  WSAHOST_NOT_FOUND   =    (WSABASEERR+1001);
  204.  HOST_NOT_FOUND      =    WSAHOST_NOT_FOUND;
  205.  { Non-Authoritative: Host not found, or SERVERFAIL }
  206.  WSATRY_AGAIN        =    (WSABASEERR+1002);
  207.  TRY_AGAIN           =    WSATRY_AGAIN;
  208.  { Non recoverable errors, FORMERR, REFUSED, NOTIMP }
  209.  WSANO_RECOVERY      =    (WSABASEERR+1003);
  210.  NO_RECOVERY         =    WSANO_RECOVERY;
  211.  { Valid name, no data record of requested type }
  212.  WSANO_DATA          =    (WSABASEERR+1004);
  213.  NO_DATA             =    WSANO_DATA;
  214.  { no address, look for MX record }
  215.  WSANO_ADDRESS       =    WSANO_DATA;
  216.  NO_ADDRESS          =    WSANO_ADDRESS;
  217.  { Windows Sockets errors redefined as regular Berkeley error constants }
  218.  EWOULDBLOCK         =    WSAEWOULDBLOCK;
  219.  EINPROGRESS         =    WSAEINPROGRESS;
  220.  EALREADY            =    WSAEALREADY;
  221.  ENOTSOCK            =    WSAENOTSOCK;
  222.  EDESTADDRREQ        =    WSAEDESTADDRREQ;
  223.  EMSGSIZE            =    WSAEMSGSIZE;
  224.  EPROTOTYPE          =    WSAEPROTOTYPE;
  225.  ENOPROTOOPT         =    WSAENOPROTOOPT;
  226.  EPROTONOSUPPORT     =    WSAEPROTONOSUPPORT;
  227.  ESOCKTNOSUPPORT     =    WSAESOCKTNOSUPPORT;
  228.  EOPNOTSUPP          =    WSAEOPNOTSUPP;
  229.  EPFNOSUPPORT        =    WSAEPFNOSUPPORT;
  230.  EAFNOSUPPORT        =    WSAEAFNOSUPPORT;
  231.  EADDRINUSE          =    WSAEADDRINUSE;
  232.  EADDRNOTAVAIL       =    WSAEADDRNOTAVAIL;
  233.  ENETDOWN            =    WSAENETDOWN;
  234.  ENETUNREACH         =    WSAENETUNREACH;
  235.  ENETRESET           =    WSAENETRESET;
  236.  ECONNABORTED        =    WSAECONNABORTED;
  237.  ECONNRESET          =    WSAECONNRESET;
  238.  ENOBUFS             =    WSAENOBUFS;
  239.  EISCONN             =    WSAEISCONN;
  240.  ENOTCONN            =    WSAENOTCONN;
  241.  ESHUTDOWN           =    WSAESHUTDOWN;
  242.  ETOOMANYREFS        =    WSAETOOMANYREFS;
  243.  ETIMEDOUT           =    WSAETIMEDOUT;
  244.  ECONNREFUSED        =    WSAECONNREFUSED;
  245.  ELOOP               =    WSAELOOP;
  246.  ENAMETOOLONG        =    WSAENAMETOOLONG;
  247.  EHOSTDOWN           =    WSAEHOSTDOWN;
  248.  EHOSTUNREACH        =    WSAEHOSTUNREACH;
  249.  ENOTEMPTY           =    WSAENOTEMPTY;
  250.  EPROCLIM            =    WSAEPROCLIM;
  251.  EUSERS              =    WSAEUSERS;
  252.  EDQUOT              =    WSAEDQUOT;
  253.  ESTALE              =    WSAESTALE;
  254.  EREMOTE             =    WSAEREMOTE;
  255.  FIONBIO             =    $8004667E;
  256.  FIONREAD            =    $4004667F;
  257.  
  258. type
  259.   { These are type definitions to ease using a C DLL }
  260.   Unsigned_Character     = byte;
  261.   Unsigned_Short_Integer = word;
  262.   Unsigned_Integer       = word;
  263.   Unsigned_Long_Integer  = longint;
  264.   { We have to do this because a Socket in Winsock is a U_INT }
  265.   TSocket                = Unsigned_Integer;
  266.   { Another C structure from Winsock; originally called "servent" }
  267.   Server_Entry = record
  268.     Server_Name     : PChar;
  269.     Server_Aliases  : ^PChar; { Note double indirection here; array of PChar }
  270.     Server_Port     : integer;
  271.     Server_Protocol : PChar;
  272.   end;
  273.   PServer_Entry = ^Server_Entry;
  274.   { This C structure was originally called "protoent" }
  275.   Protocol_Entry = record
  276.     Protocol_Name    : PChar;
  277.     Protocol_Aliases : ^PChar; { Another array of PChar }
  278.     Protocol_Id      : integer;
  279.   end;
  280.   PProtocol_Entry = ^Protocol_Entry;
  281.   { This is a clever variant record useful for casting internet addresses }
  282.   { Concept originally published by ..................................... }
  283.   Internet_Address = record
  284.     Case integer of
  285.     0: ( Net_Byte              ,
  286.          Host_Byte             ,
  287.          Local_Host_Byte       ,
  288.          Local_Machine_Byte      : Unsigned_Character );
  289.     1: ( Network_Portion       ,
  290.          Local_Machine_Portion   : Unsigned_Short_Integer );
  291.     2: ( Full_Internet_Address   : Unsigned_Long_Integer );
  292.   end;
  293.   PInternet_address = ^Internet_Address;
  294.   { This structure was originally known as "sockaddr_in" }
  295.   Internet_Socket_Address = record
  296.     Socket_Family        : integer;
  297.     Socket_Port          : Unsigned_Short_Integer;
  298.     Socket_Address       : Internet_Address;
  299.     Socket_Padding_Array : array[ 0 .. 7 ] of char;
  300.   end;
  301.   PInternet_Socket_Address = ^Internet_Socket_Address;
  302.   { This structure's C name is "hostent" }
  303.   Host_Entry = record
  304.     Host_Name              : PChar;
  305.     Host_Aliases           : ^PChar;
  306.     Host_Address_Type      : word;
  307.     Host_Address_Length    : word;
  308.     Case integer of        { Another useful variant record    }
  309.     0: ( host_address_list : ^PChar ); { Double pointer again }
  310.     1: ( host_address      : ^PInternet_address );
  311.   end;
  312.   PHost_entry = ^Host_Entry;
  313.   { This is usually called WSADATA }
  314.   Winsock_Implementation_Data = record
  315.     Winsock_Version           : word;
  316.     Winsock_High_Version      : word;
  317.     { Note these two arrays are based on global constants for size }
  318.     Description_String        : array[ 0 .. WSADESCRIPTION_LEN ] of char;
  319.     System_Status_String      : array[ 0 .. WSASYS_STATUS_LEN ] of char;
  320.     Maximum_Sockets_Allowed   : Unsigned_Short_Integer;
  321.     Maximum_UDP_Datagram_Size : Unsigned_Short_Integer;
  322.     Vendor_Specific_String    : PChar;
  323.   end;
  324.   { This is usually known as "sockaddr" }
  325.   Generic_Socket_Address = record
  326.     Socket_Family     : Unsigned_Short_Integer;
  327.     Socket_Data_Array : array[ 0 .. 13 ] of char;
  328.   end;
  329.   { This in C is "sockproto" }
  330.   Socket_Protocol = record
  331.     Protocol_Family : Unsigned_Short_Integer;
  332.     Protocol_Id     : Unsigned_Short_Integer;
  333.   end;
  334.   { This is sometimes called the "linger" structure; used only at shutdown }
  335.   Lingering_Control = record
  336.     Linger_Status   : Unsigned_Short_Integer;
  337.     Linger_Interval : Unsigned_Short_Integer;
  338.   end;
  339.   { These two event data types are used to hook into the Winsock Asynch system }
  340.   TWSAEvent = procedure( Sender : TObject; Socket : TSocket ) of object;
  341.   TWSAError = procedure( Sender     : TObject;
  342.                          ErrorCode  : Integer;
  343.                          TheMessage : String ) of object;
  344.   { This is an OOP wrapper around the Winsock calls; tries to buffer a bit }
  345.   TCCSocket = class( TWinControl )
  346.   public
  347.     Socket_WSA_Data       : Winsock_Implementation_Data;
  348.     ErrorCode           : integer;
  349.     FullErrorMessage    : string;
  350.     WinsockErrorMessage : string;
  351.     Socket_Server_Entry   : PServer_Entry;
  352.     Socket_Host_Entry     : Phost_entry;
  353.     Socket_Protocol_Entry : PProtocol_Entry;
  354.     Socket_IP_Address     : Internet_Socket_Address;
  355.     FPort_Name            : String;
  356.     FIP_Address_Name      : String;
  357.     FSocket               : TSocket;
  358.     FMasterSocket         : TSocket;
  359.     FBlockingMode         : Boolean;
  360.     FTimeoutValue         : integer;
  361.     FOnDataIsAvailable    : TWSAEvent;
  362.     FOnDataCanBeSent      : TWSAEvent;
  363.     FOnOOBDataIsAvailable : TWSAEvent;
  364.     FOnSessionClosed      : TWSAEvent;
  365.     FOnSessionIsAvailable : TWSAEvent;
  366.     FOnSessionConnected   : TWSAEvent;
  367.     FOnErrorOccurred      : TWSAError;
  368.     procedure SetStringData( TheData: string );
  369.     function GetStringData          : string;
  370.     procedure SetStringDataOutOfBand( TheData: string );
  371.     function GetStringDataOutOfBand : string;
  372.     function PeekCurrentData        : string;
  373.     function GetSocketErrorDescription( ErrorCode : integer) : string;
  374.     procedure SetSocketErrorData( SocketFunction : string );
  375.     procedure TWMPaint( var Msg : TWMPaint ); message WM_PAINT;
  376.     procedure ActivateNonAsynchTimeout;
  377.     procedure DeactivateNonAsynchTimeout;
  378.     procedure WMASyncSelect( var Msg : TMessage ); message WM_ASYNCSELECT;
  379.     procedure WMTimer( var Msg : TMessage ); message WM_TIMER;
  380.     constructor Create( AOwner : TComponent ); override;
  381.     destructor Destroy; override;
  382.     procedure CCSockConnect;
  383.     procedure CCSockClose;
  384.     procedure CCSockListen;
  385.     procedure CCSockCancelListen;
  386.     function CCSockReceive(     TheSocket     : TSocket;
  387.                                 TheTextBuffer : PChar;
  388.                             var TheTextLength : integer
  389.                           ) : integer;
  390.     function CCSockSend(    TheSocket     : TSocket;
  391.                             TheTextBuffer : PChar;
  392.                         var TheTextLength : integer
  393.                        ) : integer;
  394.     function CCSockAccept                                  : TSocket;
  395.     function GetSocketIPAddress( TheSocket: TSocket )      : string;
  396.     function GetSocketPort( TheSocket : TSocket )          : string;
  397.     function GetSocketPeerIPAddress( TheSocket : TSocket ) : string;
  398.     function GetSocketPeerPort( TheSocket : TSocket )      : string;
  399.     function SocketIsNotBlocking                           : Boolean;
  400.     procedure ActivateBlockingMode( BeginBlocking : Boolean );
  401.     property StringData      : string
  402.      read GetStringData write SetStringData;
  403.     property PeekData        : string
  404.      read PeekCurrentData;
  405.     property OutOfBand       : string
  406.      read GetStringDataOutOfBand write SetStringDataOutOfBand;
  407.     property TheSocket       : TSocket
  408.      read FSocket write FSocket;
  409.     property TheMasterSocket : TSocket
  410.      read FMasterSocket write FMasterSocket;
  411.   published
  412.     property IPAddressName        : string
  413.      read FIP_Address_Name write FIP_Address_Name;
  414.     property PortName             : string
  415.      read FPort_Name write FPort_Name;
  416.     property AsynchMode           : Boolean
  417.      read SocketIsNotBlocking write ActivateBlockingMode default True;
  418.     property NonAsynchTimeoutValue   : integer
  419.      read FTimeoutValue write FTimeoutValue default 30;
  420.     property OnDataIsAvailable    : TWSAEvent
  421.      read FOnDataIsAvailable write FOnDataIsAvailable;
  422.     property OnOOBDataIsAvailable    : TWSAEvent
  423.      read FOnOOBDataIsAvailable write FOnOOBDataIsAvailable;
  424.     property OnDataCanBeSent    : TWSAEvent
  425.      read FOnDataCanBeSent write FOnDataCanBeSent;
  426.     property OnSessionClosed      : TWSAEvent
  427.      read FOnSessionClosed write FOnSessionClosed;
  428.     property OnSessionIsAvailable : TWSAEvent
  429.      read FOnSessionIsAvailable write FOnSessionIsAvailable;
  430.     property OnSessionConnected   : TWSAEvent
  431.      read FOnSessionConnected write FOnSessionConnected;
  432.     property OnErrorOccurred      : TWSAError
  433.      read FOnErrorOccurred write FOnErrorOccurred;
  434.   end;
  435.  
  436. procedure Register;
  437.  
  438. implementation
  439.  
  440.  
  441. { External calls to Winsock DLL functions; names are kept the same }
  442. { to ease documentation lookup                                     }
  443. function accept(     TheSocket        : TSocket;
  444.                  var TheAddress       : Internet_Socket_Address;
  445.                  var TheAddressLength : integer
  446.                ) : TSocket; far; external 'WINSOCK';
  447. function bind(     TheSocket     : TSocket;
  448.                var TheAddress    : Internet_Socket_Address;
  449.                    TheNameLength : integer
  450.              ) : integer; far; external 'WINSOCK';
  451. function closesocket( TheSocket : TSocket ) : integer; far; external 'WINSOCK';
  452. function connect(      TheSocket     : TSocket;
  453.                   var  TheName       : Internet_Socket_Address;
  454.                        TheNameLength : integer
  455.                 ) : integer; far; external 'WINSOCK';
  456. function ioctlsocket(      TheSocket           : TSocket;
  457.                            TheCommand          : longint;
  458.                       var  TheCommandParameter : longint
  459.                     ) : integer; far; external 'WINSOCK';
  460. function getpeername(     TheSocket     : TSocket;
  461.                       var TheName       : Internet_Socket_Address;
  462.                       var TheNameLength : integer
  463.                     ) : integer; far; external 'WINSOCK';
  464. function getsockname(      TheSocket    : TSocket;
  465.                       var  TheName      : Internet_Socket_Address;
  466.                       var TheNameLength : integer
  467.                     ) : integer; far; external 'WINSOCK';
  468. function getsockopt(     TheSocket             : TSocket;
  469.                          TheStackLevel         : integer;
  470.                          TheOptionName         : integer;
  471.                          TheOptionStatus       : PChar;
  472.                      var TheOptionStatusLength : integer
  473.                    ) : integer; far; external 'WINSOCK';
  474. function htonl( HostOrderLongInt : Unsigned_Long_Integer ) :
  475.           Unsigned_Long_Integer; far; external 'WINSOCK';
  476. function htons( HostOrderShortInt : Unsigned_Short_Integer ) :
  477.           Unsigned_Short_Integer; far; external 'WINSOCK';
  478. function inet_addr( IPAddressName : PChar ) :
  479.           Unsigned_Long_Integer; far; external 'WINSOCK';
  480. function inet_ntoa( Socket_IP_Address:  Internet_Address ) :
  481.           PChar; far; external 'WINSOCK';
  482. function listen( TheSocket : TSocket; Backlog : integer ) :
  483.           integer; far; external 'WINSOCK';
  484. function ntohl( NetOrderLongInt : Unsigned_Long_Integer ) :
  485.           Unsigned_Long_Integer; far; external 'WINSOCK';
  486. function ntohs( NetOrderShortInt : Unsigned_Short_Integer ) :
  487.           Unsigned_Short_Integer; far; external 'WINSOCK';
  488. function recv( TheSocket     : TSocket;
  489.                TheDataBuffer : PChar;
  490.                TheDataLength : integer;
  491.                TheFlags      : integer
  492.              ) : integer; far; external 'WINSOCK';
  493. function recvfrom(     TheSocket                 : TSocket;
  494.                        TheDataBuffer             : PChar;
  495.                        TheDataLength             : integer;
  496.                        TheFlags                  : integer;
  497.                    var SocketToReceiveFrom       : Internet_Socket_Address;
  498.                    var SocketToReceiveFromLength : integer
  499.                  ) : integer; far; external 'WINSOCK';
  500. function send( TheSocket     : TSocket;
  501.                TheDataBuffer : PChar;
  502.                TheDataLength : integer;
  503.                TheFlags      : integer
  504.              ) : integer; far; external 'WINSOCK';
  505. function sendto(     TheSocket            : TSocket;
  506.                      TheDataBuffer        : PChar;
  507.                      TheDataLength        : integer;
  508.                      TheFlags             : integer;
  509.                  var SocketToSendTo       : Internet_Socket_Address;
  510.                      SocketToSendToLength : integer
  511.                ) : integer; far; external 'WINSOCK';
  512. function setsockopt( TheSocket             : TSocket;
  513.                      TheStackLevel         : integer;
  514.                      TheOptionName         : integer;
  515.                      TheOptionStatus       : PChar;
  516.                      TheOptionStatusLength : integer
  517.                    ) : integer; far; external 'WINSOCK';
  518. function shutdown( TheSocket        : TSocket;
  519.                    ActionToShutDown : integer
  520.                  ) : integer; far; external 'WINSOCK';
  521. function socket( AddressFamily : integer;
  522.                  SocketType    : integer;
  523.                  ProtocolCode  : integer
  524.                ) : TSocket; far; external 'WINSOCK';
  525. function gethostbyaddr( TheAddress    : PChar;
  526.                         TheDataLength : integer;
  527.                         SocketType    : integer
  528.                       ) : PHost_Entry; far; external 'WINSOCK';
  529. function gethostbyname( TheName : PChar ) :
  530.           PHost_Entry; far; external 'WINSOCK';
  531. function gethostname( TheName : PChar ) : integer; far; external 'WINSOCK';
  532. function getservbyport( PortCode     : integer;
  533.                         ProtocolName : PChar
  534.                       ) : PServer_Entry; far; external 'WINSOCK';
  535. function getservbyname( TheName      : PChar;
  536.                         ProtocolName : PChar
  537.                       ) : PServer_Entry; far; external 'WINSOCK';
  538. function getprotobynumber( ProtocolCode : integer ) :
  539.           PProtocol_Entry; far; external 'WINSOCK';
  540. function getprotobyname( TheName : PChar ) :
  541.           PProtocol_Entry; far; external 'WINSOCK';
  542. { Winsock Asynchronous Message-based Extensions to Berkeley Sockets }
  543. function WSAStartup(     wVersionRequired : word;
  544.                      var WIDRecord        : Winsock_Implementation_Data
  545.                    ) : integer; far; external 'WINSOCK';
  546. function WSACleanup : integer; far; external 'WINSOCK';
  547. procedure WSASetLastError( ErrorCode : integer ); far; external 'WINSOCK';
  548. function WSAGetLastError : integer; far; external 'WINSOCK';
  549. function WSAIsBlocking : Boolean; far; external 'WINSOCK';
  550. function WSASetBlockingHook : integer; far; external 'WINSOCK';
  551. function WSACancelBlockingCall : integer; far; external 'WINSOCK';
  552. function WSAAsyncGetServByName( Handle          : HWND;
  553.                                 Msg             : Unsigned_Integer;
  554.                                 TheName         : PChar;
  555.                                 ProtocolName    : PChar;
  556.                                 TheDataBuffer   : PChar;
  557.                                 TheBufferLength : integer
  558.                               ) : THandle; far; external 'WINSOCK';
  559. function WSAAsyncGetServByPort( Handle          : HWND;
  560.                                 Msg             : Unsigned_Integer;
  561.                                 PortCode        : integer;
  562.                                 ProtocolName    : PChar;
  563.                                 TheDataBuffer   : PChar;
  564.                                 TheBufferLength : integer
  565.                               ) : THandle; far; external 'WINSOCK';
  566. function WSAAsyncGetProtoByName( Handle          : HWND;
  567.                                  Msg             : Unsigned_Integer;
  568.                                  TheName         : PChar;
  569.                                  TheDataBuffer   : PChar;
  570.                                  TheBufferLength : integer
  571.                                ) : THandle; far; external 'WINSOCK';
  572. function WSAAsyncGetProtoByNumber( Handle            : HWND;
  573.                                    Msg               : Unsigned_Integer;
  574.                                    HBOProtocolNumber : integer;
  575.                                    TheDataBuffer     : PChar;
  576.                                    TheBufferLength   : integer
  577.                                  ) : THandle; far; external 'WINSOCK';
  578. function WSAAsyncGetHostByName( Handle          : HWND;
  579.                                 Msg             : Unsigned_Integer;
  580.                                 TheName         : PChar;
  581.                                 TheDataBuffer   : PChar;
  582.                                 TheBufferLength : integer
  583.                               ) : THandle; far; external 'WINSOCK';
  584. function WSAAsyncGetHostByAddr( Handle          : HWND;
  585.                                 Msg             : Unsigned_Integer;
  586.                                 TheAddress      : PChar;
  587.                                 TheDataLength   : integer;
  588.                                 AddressType     : integer;
  589.                                 TheDataBuffer   : PChar;
  590.                                 TheBufferLength : integer
  591.                                ) : THandle; far; external 'WINSOCK';
  592. function WSACancelAsyncRequest( Handle : THandle) :
  593.           THandle; far; external 'WINSOCK';
  594. function WSAAsyncSelect( TheSocket       : TSocket;
  595.                          Handle          : HWND;
  596.                          Msg             : Unsigned_Integer;
  597.                          AsynchEventCode : longint
  598.                        ) : integer; far; external 'WINSOCK';
  599.  
  600. procedure Register;
  601. begin
  602.   { Add the components to the VCL Palette }
  603.   RegisterComponents('Network' , [ TCCSocket ] );
  604. end;
  605.  
  606. { This is the override create method for the socket component }
  607. constructor TCCSocket.Create( AOwner : TComponent );
  608. var
  609.   ReturnCode : integer; { Used to signal error }
  610. begin
  611.   { Call inherited first! }
  612.   inherited Create( AOwner );
  613.   { Enable Asynch mode since in Windows }
  614.   FBlockingMode := false;
  615.   { Set Timeout for asynch ops }
  616.   FTimeoutValue := 30;
  617.   { Set up no sockets in the two native vars }
  618.   FSocket := INVALID_SOCKET;
  619.   FMasterSocket := INVALID_SOCKET;
  620.   { Start up Winsock }
  621.   ReturnCode := WSAStartup( $101 , Socket_WSA_Data );
  622.   { If don't get 0 store the error code }
  623.   if ReturnCode <> 0 then SetSocketErrorData( 'Constructor (WSAStartup)' );
  624. end;
  625.  
  626. { This is the destroy override method }
  627. destructor TCCSocket.Destroy;
  628. var
  629.   ReturnCode : integer; { Holds possible error code }
  630. begin
  631.   { Attempt to shut down winsock }
  632.   ReturnCode := WSACleanup;
  633.   { If didn't get 0 save the error }
  634.   if ReturnCode < 0 then SetSocketErrorData( 'Destructor (WSACleanup)' );
  635.   { call inherited }
  636.   inherited Destroy;
  637. end;
  638.  
  639. { This is just used to draw the nonvisual element during design time }
  640. procedure TCCSocket.TWMPaint( var Msg : TWMPaint );
  641. var
  642.   TheIcon : HIcon; { Internal icon }
  643.   TheDC   : HDC;   { Internal dc   }
  644. begin
  645.   { If in design mode draw the icon }
  646.   if csDesigning in ComponentState then
  647.   begin
  648.     { Load the icon from the instance via the DCR file }
  649.     TheIcon := LoadIcon( HInstance , MAKEINTRESOURCE( 'TCCSocket' ));
  650.     { Get a device context }
  651.     TheDC := GetDC( Handle );
  652.     { Set the internal width to that of an icon }
  653.     Width := 32;
  654.     Height := 32;
  655.     { Display the icon }
  656.     DrawIcon( TheDC , 0 , 0 , TheIcon );
  657.     { Get rid of the evidence }
  658.     ReleaseDC( Handle , TheDC );
  659.     FreeResource( TheIcon );
  660.   end;
  661.   { Let Windows know drawing is done }
  662.   ValidateRect( Handle , nil );
  663. end;
  664.  
  665. { Function to return Asynch mode }
  666. function TCCSocket.SocketIsNotBlocking: Boolean;
  667. begin
  668.   { return inverse of blocking mode }
  669.   SocketIsNotBlocking := not FBlockingMode;
  670. end;
  671.  
  672. { This turns off asynch mode via inverse of parameter }
  673. procedure TCCSocket.ActivateBlockingMode( BeginBlocking: Boolean );
  674. begin
  675.   FBlockingMode := not BeginBlocking;
  676. end;
  677.  
  678. { This is a full access method to send a string over the socket }
  679. procedure TCCSocket.SetStringData( TheData : string );
  680. var
  681.   BytesLeftToSend   ,                         { Counter for remaining data }
  682.   BytesSentSoFar    : integer;                { Counter for sent data      }
  683.   DataBuffer        : array[0..256] of char;  { Buffer for string          }
  684.   DataBufferPointer : PChar;                  { Pointer to buffer          }
  685. begin
  686.   { Copy string into char array }
  687.   StrPCopy( DataBuffer , TheData );
  688.   { Move the pointer to the array's first element into the PChar }
  689.   DataBufferPointer := @DataBuffer[ 0 ];
  690.   { Count the total chars to send }
  691.   BytesLeftToSend := Length( TheData );
  692.   { Run a loop to send the string over the socket }
  693.   while BytesLeftToSend > 0 do
  694.   begin
  695.     { Start a timeout timer if not in blocking mode }
  696.     if not FBlockingMode then ActivateNonAsynchTimeout;
  697.     { Send some bytes over the net }
  698.     BytesSentSoFar := send( FSocket , DataBufferPointer , BytesLeftToSend , 0 );
  699.     { End timeout timer if not blocking }
  700.     if not FBlockingMode then DeactivateNonAsynchTimeout;
  701.     { If get a negative response code then signal error }
  702.     if BytesSentSoFar < 0 then
  703.     begin
  704.       { Save the error data }
  705.       SetSocketErrorData( 'SetStringData (Send)' );
  706.     end
  707.     else
  708.     begin
  709.       { Decrement total bytes left to send }
  710.       BytesLeftToSend := BytesLeftToSend - BytesSentSoFar;
  711.       { Increment pointer into the string }
  712.       DataBufferPointer := DataBufferPointer + BytesSentSoFar;
  713.     end;
  714.   end;
  715. end;
  716.  
  717. { This is a full access method to read a string from the socket }
  718. function TCCSocket.GetStringData: string;
  719. var
  720.   TheDataLength     : integer; { Length of data received }
  721.   DataBuffer        : string;  { String to store data in }
  722.   DataBufferArray   : array[ 0 .. 256 ] of char absolute DataBuffer;
  723.                                { Map Pointer to string on stack }
  724. begin
  725.   { If the socket has been set up try to get some data }
  726.   if FSocket <> INVALID_SOCKET then
  727.   begin
  728.     { Activate timeout timer if not in blocking mode }
  729.     if not FBlockingMode then ActivateNonAsynchTimeout;
  730.     { Do a receive on any data waiting at the socket }
  731.     TheDataLength := recv( FSocket , @DataBufferArray[ 1 ] , 255 , 0 );
  732.     { If not blocking kill timeout timer }
  733.     if not FBlockingMode then DeactivateNonAsynchTimeout;
  734.     { If negative data length then set error }
  735.     if TheDataLength < 0 then
  736.     begin
  737.       { Set the socket error conditions }
  738.       SetSocketErrorData( 'GetStringData (Recv)' );
  739.       { Return nothing }
  740.       Result := '';
  741.     end
  742.     else
  743.     begin
  744.       { Set up pascal style string }
  745.       DataBufferArray[ 0 ] := Chr( TheDataLength );
  746.       { And return the prepared string as result }
  747.       Result := DataBuffer;
  748.     end;
  749.   end
  750.   else Result := ''; { Return empty string if invalid socket }
  751. end;
  752.  
  753. { This is a full access method to send a string as OOB data }
  754. procedure TCCSocket.SetStringDataOutOfBand( TheData: string );
  755. var
  756.   BytesLeftToSend   ,                         { Counter for remaining data }
  757.   BytesSentSoFar    : integer;                { Counter for sent data      }
  758.   DataBuffer        : array[0..256] of char;  { Buffer for string          }
  759.   DataBufferPointer : PChar;                  { Pointer to buffer          }
  760. begin
  761.   { Copy string into char array }
  762.   StrPCopy( DataBuffer , TheData );
  763.   { Move the pointer to the array's first element into the PChar }
  764.   DataBufferPointer := @DataBuffer[ 0 ];
  765.   { Count the total chars to send }
  766.   BytesLeftToSend := Length( TheData );
  767.   { Run a loop to send the string over the socket }
  768.   while BytesLeftToSend > 0 do
  769.   begin
  770.     { Start a timeout timer if not in blocking mode }
  771.     if not FBlockingMode then ActivateNonAsynchTimeout;
  772.     { Send some bytes over the net }
  773.     BytesSentSoFar := send( FSocket , DataBufferPointer ,
  774.                             BytesLeftToSend , MSG_OOB );
  775.     { End timeout timer if not blocking }
  776.     if not FBlockingMode then DeactivateNonAsynchTimeout;
  777.     { If get a negative response code then signal error }
  778.     if BytesSentSoFar < 0 then
  779.     begin
  780.       { Save the error data }
  781.       SetSocketErrorData( 'SetStringDataOutOfBand (Send)' );
  782.     end
  783.     else
  784.     begin
  785.       { Decrement total bytes left to send }
  786.       BytesLeftToSend := BytesLeftToSend - BytesSentSoFar;
  787.       { Increment pointer into the string }
  788.       DataBufferPointer := DataBufferPointer + BytesSentSoFar;
  789.     end;
  790.   end;
  791. end;
  792.  
  793. { This is a full access method to receive out of band data as a string }
  794. function TCCSocket.GetStringDataOutOfBand: string;
  795. var
  796.   TheDataLength     : integer; { Length of data received }
  797.   DataBuffer        : string;  { String to store data in }
  798.   DataBufferArray   : array[ 0 .. 256 ] of char absolute DataBuffer;
  799.                                { Map Pointer to string on stack }
  800. begin
  801.   { If the socket has been set up try to get some data }
  802.   if FSocket <> INVALID_SOCKET then
  803.   begin
  804.     { Activate timeout timer if not in blocking mode }
  805.     if not FBlockingMode then ActivateNonAsynchTimeout;
  806.     { Do a receive on any data waiting at the socket }
  807.     TheDataLength := recv( FSocket , @DataBufferArray[ 1 ] , 255 , MSG_OOB );
  808.     { If not blocking kill timeout timer }
  809.     if not FBlockingMode then DeactivateNonAsynchTimeout;
  810.     { If negative data length then set error }
  811.     if TheDataLength < 0 then
  812.     begin
  813.       { Set the socket error conditions }
  814.       SetSocketErrorData( 'GetStringDataOutOfBand (Recv)' );
  815.       { Return nothing }
  816.       Result := '';
  817.     end
  818.     else
  819.     begin
  820.       { Set up pascal style string }
  821.       DataBufferArray[ 0 ] := Chr( TheDataLength );
  822.       { And return the prepared string as result }
  823.       Result := DataBuffer;
  824.     end;
  825.   end
  826.   else Result := ''; { Return empty string if invalid socket }
  827. end;
  828.  
  829. function TCCSocket.PeekCurrentData: string;
  830. var
  831.   TheDataLength     : integer; { Length of data received }
  832.   DataBuffer        : string;  { String to store data in }
  833.   DataBufferArray   : array[ 0 .. 256 ] of char absolute DataBuffer;
  834.                                { Map Pointer to string on stack }
  835. begin
  836.   { If the socket has been set up try to get some data }
  837.   if FSocket <> INVALID_SOCKET then
  838.   begin
  839.     { Activate timeout timer if not in blocking mode }
  840.     if not FBlockingMode then ActivateNonAsynchTimeout;
  841.     { Do a receive on any data waiting at the socket }
  842.     TheDataLength := recv( FSocket , @DataBufferArray[ 1 ] , 255 , MSG_PEEK );
  843.     { If not blocking kill timeout timer }
  844.     if not FBlockingMode then DeactivateNonAsynchTimeout;
  845.     { If negative data length then set error }
  846.     if TheDataLength < 0 then
  847.     begin
  848.       { Set the socket error conditions }
  849.       SetSocketErrorData( 'PeekCurrentData (PeekData)' );
  850.       { Return nothing }
  851.       Result := '';
  852.     end
  853.     else
  854.     begin
  855.       { Set up pascal style string }
  856.       DataBufferArray[ 0 ] := Chr( TheDataLength );
  857.       { And return the prepared string as result }
  858.       Result := DataBuffer;
  859.     end;
  860.   end
  861.   else Result := ''; { Return empty string if invalid socket }
  862. end;
  863.  
  864. { This is a full access method to get the port id for a given socket }
  865. function TCCSocket.GetSocketPort( TheSocket : TSocket ) : string;
  866. var
  867.   TheAddress       : Internet_Socket_Address;  { Hold address info     }
  868.   TheAddressLength : integer;                  { Hold addr info length }
  869. begin
  870.   { Find out the size of the structure }
  871.   TheAddressLength := SizeOf( TheAddress );
  872.   { Call the winsock dll routine }
  873.   getsockname( TheSocket , TheAddress , TheAddressLength );
  874.   { Pull off the properly-byte-ordered port number as a string }
  875.   Result := IntToStr( ntohs( TheAddress.Socket_Port ));
  876. end;
  877.  
  878. { This is a full access method to get the IP Address of a given socket }
  879. function TCCSocket.GetSocketIPAddress( TheSocket : TSocket ) : string;
  880. var
  881.   TheAddress       : Internet_Socket_Address; { Holds address info   }
  882.   TheAddressLength : integer;                 { Holds size of info   }
  883.   AddressPChar     : PChar;                   { holds converted info }
  884. begin
  885.   { Get the size of the address record }
  886.   TheAddressLength := SizeOf( TheAddress );
  887.   { Call the Winsock DLL function }
  888.   getsockname( TheSocket , TheAddress , TheAddressLength );
  889.   { Make the conversion from 32 bit to dotted decimal }
  890.   AddressPChar := inet_ntoa( TheAddress.Socket_Address );
  891.   { return it as a pascal string }
  892.   Result := StrPas( AddressPChar );
  893. end;
  894.  
  895. { This is a full access method to get the port number of the other end of a socket }
  896. function TCCSocket.GetSocketPeerPort( TheSocket : TSocket ) : string;
  897. var
  898.   TheAddress       : Internet_Socket_Address;  { Hold address info     }
  899.   TheAddressLength : integer;                  { Hold addr info length }
  900. begin
  901.   { Find out the size of the structure }
  902.   TheAddressLength := SizeOf( TheAddress );
  903.   { Call the winsock dll routine }
  904.   getpeername( TheSocket , TheAddress , TheAddressLength );
  905.   { Pull off the properly-byte-ordered port number as a string }
  906.   Result := IntToStr( ntohs( TheAddress.Socket_Port ));
  907. end;
  908.  
  909. { This is a full access method to get the ip address of the other end of a socket }
  910. function TCCSocket.GetSocketPeerIPAddress(TheSocket: TSocket): string;
  911. var
  912.   TheAddress       : Internet_Socket_Address; { Holds address info   }
  913.   TheAddressLength : integer;                 { Holds size of info   }
  914.   AddressPChar     : PChar;                   { holds converted info }
  915. begin
  916.   { Get the size of the address record }
  917.   TheAddressLength := SizeOf( TheAddress );
  918.   { Call the Winsock DLL function }
  919.   getpeername( TheSocket , TheAddress , TheAddressLength );
  920.   { Make the conversion from 32 bit to dotted decimal }
  921.   AddressPChar := inet_ntoa( TheAddress.Socket_Address );
  922.   { return it as a pascal string }
  923.   Result := StrPas( AddressPChar );
  924. end;
  925.  
  926. { This is a full access method to receive a PChar of up to 64K of data at once }
  927. function TCCSocket.CCSockReceive(    TheSocket     : TSocket;
  928.                                      TheTextBuffer : PChar;
  929.                                  var TheTextLength : integer
  930.                                 ) : integer;
  931. begin
  932.   { If not an invalid socket then do the receive }
  933.   if FSocket <> INVALID_SOCKET then
  934.   begin
  935.     { If not in block mode then activate timeout timer }
  936.     if not FBlockingMode then ActivateNonAsynchTimeout;
  937.     { Return the direct result of the recv call into Winsock }
  938.     Result := recv( TheSocket , TheTextBuffer , TheTextLength , 0 );
  939.     { If not blocking kill timeout timer }
  940.     if not FBlockingMode then DeactivateNonAsynchTimeout;
  941.     { If negative length then get error info }
  942.     if TheTextLength < 0 then SetSocketErrorData( 'CCSockReceive' );
  943.   end
  944.   else Result := -1; { Return invalid PChar if not valid socket }
  945. end;
  946.  
  947. { This is a full access method to send a PChar of up to 64K of data at once }
  948. function TCCSocket.CCSockSend(    TheSocket     : TSocket;
  949.                                   TheTextBuffer : PChar;
  950.                               var TheTextLength : integer
  951.                              ) : integer;
  952. begin
  953.   { If not blocking then activate timeout timer }
  954.   if not FBlockingMode then ActivateNonAsynchTimeout;
  955.   { Send the info through raw }
  956.   TheTextLength := send( TheSocket , TheTextBuffer , TheTextLength , 0 );
  957.   { if not blocking then deactivate timeout timer }
  958.   if not FBlockingMode then DeactivateNonAsynchTimeout;
  959.   { if error code then get winsock error status }
  960.   if TheTextLength < 0 then SetSocketErrorData( 'CCSockSend' );
  961.   { return SOCKET_ERROR or number of bytes sent }
  962.   Result := TheTextLength;
  963. end;
  964.  
  965. { This method handles Asynchronous Windows messages for the Winsock }
  966. procedure TCCSocket.WMASyncSelect( var Msg : TMessage );
  967. begin
  968.   { The low word of the lParam field of the Msg is the event code }
  969.   case LoWord( Msg.lParam ) of
  970.     { This indicates data is available for reading on the socket }
  971.     FD_READ : begin
  972.                 if Assigned( FOnDataIsAvailable ) then
  973.                  FOnDataIsAvailable( Self , Msg.wParam ); { wParam = socket ID }
  974.               end;
  975.     { This indicates data is available for sending on the socket }
  976.     FD_WRITE : begin
  977.                 if Assigned( FOnDataCanBeSent ) then
  978.                  FOnDataCanBeSent( Self , Msg.wParam );
  979.               end;
  980.     { This indicates OOB data is available for reading on the socket }
  981.     FD_OOB : begin
  982.                 if Assigned( FOnOOBDataIsAvailable ) then
  983.                  FOnOOBDataIsAvailable( Self , Msg.wParam );
  984.               end;
  985.     { This indicates the socket has an incoming connection for accept }
  986.     FD_ACCEPT : begin
  987.                   if Assigned( FOnSessionIsAvailable ) then
  988.                    FOnSessionIsAvailable( Self , Msg.wParam );
  989.                 end;
  990.     { This indicates an outgoing connection has been accepted by peer }
  991.     FD_CONNECT: begin
  992.                   if Assigned( FOnSessionConnected ) then
  993.                    FOnSessionConnected( Self , Msg.wParam );
  994.                 end;
  995.     { This indicates the socket has been closed; presumably by peer }
  996.     FD_CLOSE : begin
  997.                  if Assigned( FOnSessionClosed ) then
  998.                   FOnSessionClosed( Self , Msg.wParam );
  999.                end;
  1000.   end;
  1001. end;
  1002.  
  1003. { This handles Asynchronous Timeouts gracefully }
  1004. procedure TCCSocket.WMTimer( var Msg : TMessage );
  1005. begin
  1006.   { Kill a running timer }
  1007.   KillTimer( Handle , 10 );
  1008.   { If the socket is blocking then deal with timeout }
  1009.   if WSAIsBlocking then
  1010.   begin
  1011.     { Cancel the blocking operation }
  1012.     WSACancelBlockingCall;
  1013.     { Return blocking call timeout error message }
  1014.     if Assigned( FOnErrorOccurred ) then
  1015.       FOnErrorOccurred( Self , WSAETIMEDOUT , 'Blocking call timed out' );
  1016.   end;
  1017. end;
  1018.  
  1019. { This is a wrapper method around the complexity of connecting a socket }
  1020. procedure TCCSocket.CCSockConnect;
  1021. var
  1022.   ReturnCode : integer;                    { Generic return code var }
  1023.   TcpPChar   : PChar;                      { Boilerplate TCP string  }
  1024.   PortName   : array[ 0 .. 31 ] of char;   { PChar for port name     }
  1025.   DataBuffer : array[ 0 .. 256 ] of char;  { Generic buffer PChar    }
  1026.   DummyValue : longint;                    { Must use variable call  }
  1027. begin
  1028.   { No port name set error }
  1029.   if FPort_Name = '' then
  1030.   begin
  1031.     SetSocketErrorData( 'No Valid Port Name in CCSockConnect');
  1032.     exit;
  1033.   end;
  1034.   { No IP address set error }
  1035.   if FIP_Address_Name = '' then
  1036.   begin
  1037.     SetSocketErrorData( 'No Valid IP Address in CCSockConnect');
  1038.     exit;
  1039.   end;
  1040.   { Set required family value }
  1041.   Socket_IP_Address.Socket_Family := AF_INET;
  1042.   { Move the port name into the PChar }
  1043.   StrPCopy( PortName , FPort_Name );
  1044.   { Set up the boilerplate pchar }
  1045.   TcpPChar := 'tcp';
  1046.   { Do blocking call on server }
  1047.   Socket_Server_Entry := getservbyname( PortName , TcpPChar );
  1048.   { If no reply then use default from name }
  1049.   if Socket_Server_Entry = nil then
  1050.   begin
  1051.     Socket_IP_Address.Socket_Port := htons( StrToInt( StrPas( PortName )));
  1052.   end
  1053.   else
  1054.   begin
  1055.     { Otherwise use the replied value }
  1056.     Socket_IP_Address.Socket_Port := Socket_Server_Entry^.Server_Port;
  1057.   end;
  1058.   { Move the IP address into the data buffer }
  1059.   StrPCopy( DataBuffer , FIP_Address_Name );
  1060.   { Turn it into a real IP address in binary form }
  1061.   Socket_IP_Address.Socket_Address.Full_Internet_Address :=
  1062.    inet_addr( DataBuffer );
  1063.   { If not found then do remote lookup }
  1064.   if Socket_IP_Address.Socket_Address.Full_Internet_Address = INADDR_NONE then
  1065.   begin
  1066.     { Call blocking function on IP name }
  1067.     Socket_Host_Entry := gethostbyname( DataBuffer );
  1068.     { If still no good then error out and exit }
  1069.     if Socket_Host_Entry = nil then
  1070.     begin
  1071.       SetSocketErrorData( 'Cannot convert host address in CCSockConnect');
  1072.       exit;
  1073.     end;
  1074.     { Otherwise get the address }
  1075.     Socket_IP_Address.Socket_Address := Socket_Host_Entry^.Host_Address^^;
  1076.   end;
  1077.   { Do protocol acquisition via blocking call }
  1078.   Socket_Protocol_Entry := getprotobyname( TcpPChar );
  1079.   { Create a socket }
  1080.   FSocket := socket( PF_INET ,
  1081.                      SOCK_STREAM ,
  1082.                      Socket_Protocol_Entry^.Protocol_Id );
  1083.   { If error code then exit with value set }
  1084.   if FSocket < 0 then
  1085.   begin
  1086.     SetSocketErrorData('CCSockConnect (socket)');
  1087.     exit;
  1088.   end;
  1089.   { If asynchmode then setup for asynch calls }
  1090.   if not FBlockingMode then
  1091.   begin
  1092.     { Do ass call and allow all callback states; note this will }
  1093.     { send a message when connected.                            }
  1094.     ReturnCode := WSAASyncSelect( FSocket , Handle , WM_ASYNCSELECT ,
  1095.       FD_READ or FD_WRITE or FD_OOB or FD_CLOSE or FD_CONNECT );
  1096.     { If get error say so }
  1097.     if ReturnCode <> 0 then SetSocketErrorData( 'WSAAsyncSelect' );
  1098.   end
  1099.   else
  1100.   begin
  1101.     { Otherwise set blocking mode }
  1102.     DummyValue := 0;
  1103.     ReturnCode := ioctlsocket( FSocket , FIONBIO , DummyValue );
  1104.     { Set up timeout on blocking call }
  1105.     ActivateNonAsynchTimeout;
  1106.     { Attempt blocking connect }
  1107.     ReturnCode := connect( FSocket ,
  1108.                            Socket_IP_Address ,
  1109.                            SizeOf( Socket_IP_Address ));
  1110.     { Deactivate timeout on blocking call }
  1111.     DeactivateNonAsynchTimeout;
  1112.     { If any other error than WouldBlock signal connection error }
  1113.     if ReturnCode <> 0 then
  1114.     begin
  1115.       ReturnCode := WSAGetLastError;
  1116.       if ReturnCode <> WSAEWOULDBLOCK then
  1117.        SetSocketErrorData( 'CCSockConnect' );
  1118.     end;
  1119.   end;
  1120. end;
  1121.  
  1122. { This is a method to set the socket to a listening mode (ie server) }
  1123. procedure TCCSocket.CCSockListen;
  1124. const
  1125.   DummyValue : Longint = 0;
  1126. var
  1127.   ReturnCode : integer;
  1128.   TcpPChar   : PChar;
  1129.   PortName   : array[0..31] of char;
  1130.   { szData: array[0..256] of char;}
  1131. begin
  1132.   { Invalid Port Name error }
  1133.   if FPort_Name = '' then
  1134.   begin
  1135.     SetSocketErrorData( 'No Port Specified in CCSockListen' );
  1136.     exit;
  1137.   end;
  1138.   { Set default AF_INET family }
  1139.   Socket_IP_Address.Socket_Family := AF_INET;
  1140.   { Set any IP Address }
  1141.   Socket_IP_Address.Socket_Address.Full_Internet_Address := INADDR_ANY;
  1142.   { Set default TCP string }
  1143.   TcpPChar := 'tcp';
  1144.   { Create PChar of port name }
  1145.   StrPCopy( PortName , FPort_Name );
  1146.   { Use blocking call to get server }
  1147.   Socket_Server_Entry := getservbyname( PortName , TcpPChar );
  1148.   { If no entry the use default number otherwise use returned one }
  1149.   if Socket_Server_Entry = nil then
  1150.      Socket_IP_Address.Socket_Port := htons( StrToInt( StrPas( PortName )))
  1151.   else Socket_IP_Address.Socket_Port := Socket_Server_Entry^.Server_Port;
  1152.   { Use blocking call to get protocol }
  1153.   Socket_Protocol_Entry := getprotobyname( TcpPChar );
  1154.   { Set up the server socket }
  1155.   FMasterSocket := socket( PF_INET     ,
  1156.                            SOCK_STREAM ,
  1157.                            Socket_Protocol_Entry^.Protocol_Id );
  1158.   { If socket error return code and exit }
  1159.   if FMasterSocket < 0 then
  1160.   begin
  1161.     SetSocketErrorData( 'socket' );
  1162.     exit;
  1163.   end;
  1164.   { Bind the server socket }
  1165.   ReturnCode := bind( FMasterSocket ,
  1166.                       Socket_IP_Address,
  1167.                       SizeOf( Socket_IP_Address ));
  1168.   { If socket error then signal and exit }
  1169.   if ReturnCode <> 0 then
  1170.   begin
  1171.     SetSocketErrorData( 'Bind' );
  1172.     exit;
  1173.   end;
  1174.   { Do a listen call to set up waiting state }
  1175.   ReturnCode := listen( FMasterSocket , 5 );
  1176.   { If socket error then signal and exit }
  1177.   if ReturnCode <> 0 then
  1178.   begin
  1179.     SetSocketErrorData( 'Listen' );
  1180.     exit;
  1181.   end;
  1182.   { If not blocking do asynch call }
  1183.   if not FBlockingMode then
  1184.   begin
  1185.     { Set up asynch call }
  1186.     ReturnCode := WSAASyncSelect( FMasterSocket  ,
  1187.                                   Handle         ,
  1188.                                   WM_ASYNCSELECT ,
  1189.                                   FD_READ or FD_WRITE or FD_OOB
  1190.                                    or FD_ACCEPT or FD_CLOSE );
  1191.     { If error then signal }
  1192.     if ReturnCode <> 0 then SetSocketErrorData('WSAASyncSelect');
  1193.   end
  1194.   else ioctlsocket( FMasterSocket , FIONBIO , DummyValue ); { otherwise set blocking }
  1195. end;
  1196.  
  1197. { This method terminates a listening mode (server) }
  1198. procedure TCCSocket.CCSockCancelListen;
  1199. var
  1200.   ReturnCode : integer; { status code var }
  1201. begin
  1202.   { if not blocking then turn off asynch mode }
  1203.   if not FBlockingMode then
  1204.     WSAASyncSelect( FMasterSocket , Handle , WM_ASYNCSELECT , 0 );
  1205.   { Shutdown call }
  1206.   shutdown( FMasterSocket , 2 );
  1207.   { Close the socket }
  1208.   ReturnCode := closesocket( FMasterSocket );
  1209.   { If socket error signal it }
  1210.   if ReturnCode <> 0 then
  1211.     SetSocketErrorData( 'CancelListen (closesocket)' );
  1212.   { kill socket id }
  1213.   FMasterSocket := 0;
  1214. end;
  1215.  
  1216. { This is the blocking mode accept procedure }
  1217. function TCCSocket.CCSockAccept: TSocket;
  1218. const
  1219.   DummyValue : Longint = 0;
  1220. var
  1221.   ReturnCode    : integer; { status code }
  1222.   TheDataLength : integer; { data length }
  1223. begin
  1224.   { Get length of the address variable }
  1225.   TheDataLength := sizeof( Socket_IP_Address );
  1226.   { if blocking then do timeout }
  1227.   if FBlockingMode then ActivateNonAsynchTimeout;
  1228.   { Do blocking accept call }
  1229.   FSocket := accept( FMasterSocket     ,
  1230.                      Socket_IP_Address ,
  1231.                      TheDataLength       );
  1232.   { If blocking }
  1233.   if FBlockingMode then
  1234.   begin
  1235.     { Kill timeout timer }
  1236.     DeactivateNonAsynchTimeout;
  1237.     { Turn on blocking on accepted socket }
  1238.     ioctlsocket( FSocket , FIONBIO , DummyValue );
  1239.   end;
  1240.   { If no accept then signal error }
  1241.   if FSocket < 0 then SetSocketErrorData( 'Accept' );
  1242.   { Return Socket ID }
  1243.   Result := FSocket;
  1244. end;
  1245.  
  1246. { Close a socket in either mode }
  1247. procedure TCCSocket.CCSockClose;
  1248. var
  1249.   ReturnCode   : integer;            { status code var }
  1250.   LingerRecord : Lingering_Control;  { linger var      }
  1251.   LingerArray  : array[ 0 .. 3 ] of char absolute LingerRecord;
  1252.                                      { pointer into la }
  1253. begin
  1254.   { If not blocking then turn of asynch messaging }
  1255.   if not FBlockingMode then
  1256.     WSAASyncSelect( FSocket , Handle , WM_ASYNCSELECT , 0 );
  1257.   { cancel any blocking }
  1258.   if WSAIsBlocking then WSACancelBlockingCall;
  1259.   { shut down the socket }
  1260.   shutdown( FSocket , 2 );
  1261.   { Set up the linger record }
  1262.   LingerRecord.Linger_Status := 1;
  1263.   LingerRecord.Linger_Interval := 0;
  1264.   { Set up the linger status via setsockopt }
  1265.   setsockopt( FSocket     ,
  1266.               SOL_SOCKET  ,
  1267.               SO_LINGER   ,
  1268.               LingerArray ,
  1269.               sizeof( LingerRecord ));
  1270.   { Do the close call }
  1271.   ReturnCode := closesocket( FSocket );
  1272.   { signal error if one happens }
  1273.   if ReturnCode <> 0 then SetSocketErrorData( 'Disconnect (closesocket)' );
  1274.   { set socket to invalid value }
  1275.   FSocket := INVALID_SOCKET;
  1276. end;
  1277.  
  1278. { This sets up internal values for retrieval in case errors occur }
  1279. procedure TCCSocket.SetSocketErrorData( SocketFunction : string );
  1280. begin
  1281.   { Get any winsock error }
  1282.   ErrorCode := WSAGetLastError;
  1283.   { Get text description of error }
  1284.   WinsockErrorMessage := GetSocketErrorDescription( ErrorCode );
  1285.   { Setup full error message for user friendliness }
  1286.   if WinsockErrorMessage <> 'No Error' then
  1287.    FullErrorMessage := 'Error '+ WinsockErrorMessage +
  1288.     ' in function ' + SocketFunction else FullErrorMessage :=
  1289.      SocketFunction;
  1290.   { call error event handler }
  1291.   if Assigned( FOnErrorOccurred ) then
  1292.     FOnErrorOccurred( Self , ErrorCode , FullErrorMessage );
  1293. end;
  1294.  
  1295. { Boilerplate error descriptions }
  1296. function TCCSocket.GetSocketErrorDescription( ErrorCode : integer ) : string;
  1297. begin
  1298.   case ErrorCode of
  1299.     WSAEINTR:
  1300.       GetSocketErrorDescription := 'System Interrupt Failure';
  1301.     WSAEBADF:
  1302.       GetSocketErrorDescription := 'Bad File Failure';
  1303.     WSAEACCES:
  1304.       GetSocketErrorDescription := 'File Permission Denied Failure';
  1305.     WSAEFAULT:
  1306.       GetSocketErrorDescription := 'Bad IP Address Failure';
  1307.     WSAEINVAL:
  1308.       GetSocketErrorDescription := 'Invalid Winsock API Call Argument Failure';
  1309.     WSAEMFILE:
  1310.       GetSocketErrorDescription := 'Too Many Open Files Failure';
  1311.     WSAEWOULDBLOCK:
  1312.       GetSocketErrorDescription := 'Operation Would Block Failure';
  1313.     WSAEINPROGRESS:
  1314.       GetSocketErrorDescription := 'Operation Blocking Failure';
  1315.     WSAEALREADY:
  1316.       GetSocketErrorDescription := 'Operation Already in Progress Failure';
  1317.     WSAENOTSOCK:
  1318.       GetSocketErrorDescription := 'Invalid Socket Operation Failure';
  1319.     WSAEDESTADDRREQ:
  1320.       GetSocketErrorDescription := 'No Destination Address Failure';
  1321.     WSAEMSGSIZE:
  1322.       GetSocketErrorDescription := 'Invalid Message Length Failure';
  1323.     WSAEPROTOTYPE:
  1324.       GetSocketErrorDescription := 'Invalid Protocol For Socket Failure';
  1325.     WSAENOPROTOOPT:
  1326.       GetSocketErrorDescription := 'Unavilable Protocol Failure';
  1327.     WSAEPROTONOSUPPORT:
  1328.       GetSocketErrorDescription := 'Unsupported Protocol Failure';
  1329.     WSAESOCKTNOSUPPORT:
  1330.       GetSocketErrorDescription := 'Unsupported Socket Type Failure';
  1331.     WSAEOPNOTSUPP:
  1332.       GetSocketErrorDescription := 'Unsupported Socket Operation Failure';
  1333.     WSAEPFNOSUPPORT:
  1334.       GetSocketErrorDescription := 'Unsupported Protocol Family Failure';
  1335.     WSAEAFNOSUPPORT:
  1336.       GetSocketErrorDescription := 'Invalid Protocol-Address Family Failure';
  1337.     WSAEADDRINUSE:
  1338.       GetSocketErrorDescription := 'Address In Use Failure';
  1339.     WSAEADDRNOTAVAIL:
  1340.       GetSocketErrorDescription := 'Unavailable Address Failure';
  1341.     WSAENETDOWN:
  1342.       GetSocketErrorDescription := 'Network Down Failure';
  1343.     WSAENETUNREACH:
  1344.       GetSocketErrorDescription := 'Network Unreachable Failure';
  1345.     WSAENETRESET:
  1346.       GetSocketErrorDescription := 'Network Connection Dropped Failure';
  1347.     WSAECONNABORTED:
  1348.       GetSocketErrorDescription := 'Software Abort Failure';
  1349.     WSAECONNRESET:
  1350.       GetSocketErrorDescription := 'Peer Connection Reset Failure';
  1351.     WSAENOBUFS:
  1352.       GetSocketErrorDescription := 'Buffer Overflow Failure';
  1353.     WSAEISCONN:
  1354.       GetSocketErrorDescription := 'Connected Socket Failure';
  1355.     WSAENOTCONN:
  1356.       GetSocketErrorDescription := 'Unconnected Socket Failure';
  1357.     WSAESHUTDOWN:
  1358.       GetSocketErrorDescription := 'Closed Socket Send Failure';
  1359.     WSAETOOMANYREFS:
  1360.       GetSocketErrorDescription := 'Reference Count Overflow Failure';
  1361.     WSAETIMEDOUT:
  1362.       GetSocketErrorDescription := 'Connection Timeout Failure';
  1363.     WSAECONNREFUSED:
  1364.       GetSocketErrorDescription := 'Connection Refusal Failure';
  1365.     WSAELOOP:
  1366.       GetSocketErrorDescription := 'Symbolic Link Overflow Failure';
  1367.     WSAENAMETOOLONG:
  1368.       GetSocketErrorDescription := 'Invalid File Name Failure';
  1369.     WSAEHOSTDOWN:
  1370.       GetSocketErrorDescription := 'Host Down Failure';
  1371.     WSAEHOSTUNREACH:
  1372.       GetSocketErrorDescription := 'Host Unreachable Failure';
  1373.     WSAENOTEMPTY:
  1374.       GetSocketErrorDescription := 'Non-Empty Directory Removal Failure';
  1375.     WSAEPROCLIM:
  1376.       GetSocketErrorDescription := 'Process Overflow Failure';
  1377.     WSAEUSERS:
  1378.       GetSocketErrorDescription := 'Users Overflow Failure';
  1379.     WSAEDQUOT:
  1380.       GetSocketErrorDescription := 'Disk Quota Overflow Failure';
  1381.     WSAESTALE:
  1382.       GetSocketErrorDescription := 'Invalid File Handle Failure';
  1383.     WSAEREMOTE:
  1384.       GetSocketErrorDescription := 'File Path Overflow Failure';
  1385.     WSASYSNOTREADY:
  1386.       GetSocketErrorDescription := 'Unavailable Sub-Network Failure';
  1387.     WSAVERNOTSUPPORTED:
  1388.       GetSocketErrorDescription := 'Winsock Application Compatibility Failure';
  1389.     WSANOTINITIALISED:
  1390.       GetSocketErrorDescription := 'WinSock Uninitialized Failure';
  1391.     WSAHOST_NOT_FOUND:
  1392.       GetSocketErrorDescription := 'Host Not Located Failure';
  1393.     WSATRY_AGAIN:
  1394.       GetSocketErrorDescription := 'Non-Authority Host Not Located Failure';
  1395.     WSANO_RECOVERY:
  1396.       GetSocketErrorDescription := 'Fatal Winsock Error Failure';
  1397.     WSANO_DATA:
  1398.       GetSocketErrorDescription := 'Data Not Available Failure';
  1399.     else GetSocketErrorDescription := 'No Error';
  1400.   end;
  1401. end;
  1402.  
  1403. { Activate timeout procedure }
  1404. procedure TCCSocket.ActivateNonAsynchTimeout;
  1405. begin
  1406.   if FTimeoutValue > 0 then
  1407.     SetTimer( Handle , 10 , FTimeoutValue * 1000 , nil );
  1408. end;
  1409.  
  1410. { Deactivate timeout procedure }
  1411. procedure TCCSocket.DeactivateNonAsynchTimeout;
  1412. begin
  1413.   if FTimeoutValue > 0 then KillTimer( Handle , 10 );
  1414. end;
  1415.  
  1416. end.
  1417.