home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / socket / sockets.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1995-12-22  |  34.6 KB  |  998 lines
  1. unit Sockets;
  2. { Install this component using Options|Install Compenents.
  3.   The function of this module is to provide Delphi with a
  4.   component capable of performing TCP/IP Socket's functions
  5.   by interfacing with WINSOCK.DLL provided by many vendors
  6.   including Microsoft.
  7.  
  8.   The code herein is released to the public domain under the condition
  9.   that it will not be used for commercial or "For Profit" ventures.
  10.  
  11.   Written By:      Gary T. Desrosiers
  12.   Date:            March 27th, 1995.
  13.   Copyright:       (R) Copyright by Gary T. Desrosiers, 1995. All Rights Reserved
  14.   UserID(s):       71062,2754
  15.                    desrosi@pcnet.com
  16.  
  17.   Description:     This control performs WinSock TCP/IP functions.
  18.  
  19.   Properties:      IPAddr, Design time and runtime read/write.
  20.                      Sets the IP Address of the partner that you will
  21.                      eventually SConnect to. You may specify this as
  22.                      dotted decimal or a literal name to be converted
  23.                      via DNS.
  24.                      examples;
  25.                        Sockets1.IPAddr := 'desrosi';
  26.                        Sockets1.IPAddr := '127.0.0.1';
  27.                        addr := Sockets1.IPAddr;
  28.  
  29.                    Port, Design time and runtime read/write.
  30.                      Sets the Port number of the remote port to connect
  31.                      to or the local port to listen on depending on
  32.                      whether you subsequently issue a SConnect or SListen.
  33.                      This can be specified as a number or a literal name
  34.                      to be converted via DNS.
  35.                      examples;
  36.                        Sockets1.Port := 'echo';
  37.                        Sockets1.Port := '7';
  38.                        port := Sockets1.Port;
  39.  
  40.                    SocketNumber, Runtime Readonly.
  41.                      Returns the socket number of the currently allocated
  42.                      connection.
  43.                      example;
  44.                        sock := Sockets1.SocketNumber;
  45.  
  46.                    Text, Design time and runtime read/write.
  47.                      if set, sends the text to the partner.
  48.                      if read, receives some text from the partner.
  49.                      examples;
  50.                        buffer := Sockets1.Text; (* Receive data *)
  51.                        Sockets1.Text := 'This is a test'; (* Send Data *)
  52.  
  53. Methods:           SConnect - Connects to the remote (or local) system
  54.                      specified in the IPAddr and Port properties.
  55.                      example;
  56.                        Sockets1.SConnect; (* Connect to partner *)
  57.  
  58.                    SListen - Listens on the port specified in the Port
  59.                      property.
  60.                      example;
  61.                        Sockets1.SListen; (* Establish server environment *)
  62.  
  63.                    SAccept - Accepts a client request. Usually issued in
  64.                      OnSessionAvailable event.
  65.                      example;
  66.                        Sock := Sockets1.SAccept; (* Get client connection *)
  67.  
  68.                    SClose - Closes the socket.
  69.                      example;
  70.                        Sockets1.SClose; (* Close connection *)
  71.  
  72.                    SReceive - Receives data from partner, similar to
  73.                      reading the property Text.
  74.                      example;
  75.                        buffer := Sockets1.SReceive(Sockets1.SocketNumber,255);
  76.  
  77.                    SSend - Sends data to the partner, similar to
  78.                      setting the property Text.
  79.                      example;
  80.                        Sockets1.SSend(Sockets1.SocketNumber,buffer,25);
  81.  
  82. Events:            OnDataAvailable - Called when data is available to
  83.                      be received from the partner. You should issue;
  84.                      buffer := Sockets1.Text; or a SReceive method to
  85.                      receive the data from the partner.
  86.  
  87.                    OnSessionAvailable - Called when a client has requested
  88.                      to connect to a 'listening' server. You can call
  89.                      the method SAccept here.
  90.  
  91.                    OnSessionClosed - Called when the partner has closed
  92.                      a socket on you. Normally, you would close your side
  93.                      of the socket when this event happens.
  94.  
  95.                    OnSessionConnected - Called when the SConnect has
  96.                      completed and the session is connected. This is a
  97.                      good place to send the initial data of a conversation.
  98.                      Also, you may want to enable certain controls that
  99.                      allow the user to send data on the conversation here.
  100. }
  101. interface
  102.  
  103. uses
  104.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  105.   Forms, Dialogs;
  106. const
  107.   { Not all of these constants are used in this component, I included
  108.     the entire WinSock.h header file constants for completeness. }
  109.  
  110.   { User Windows Messages }
  111.   WM_ASYNCSELECT = WM_USER + 0;
  112.  
  113.   { Misc constants }
  114.   FD_SETSIZE = 64;
  115.   INADDR_ANY: longint = 0;
  116.   INADDR_NONE: longint = -1;
  117.   INADDR_LOOPBACK: longint = $7f000001; { IPAddr: 127.0.0.1 }
  118.   WSADESCRIPTION_LEN = 256;
  119.   WSASYS_STATUS_LEN = 128;
  120.  
  121.   { Protocols }
  122.   IPPROTO_IP         =  0;              { dummy for IP }
  123.   IPPROTO_ICMP       =  1;              { control message protocol }
  124.   IPPROTO_GGP        =  2;              { gateway^2 (deprecated) }
  125.   IPPROTO_TCP        =  6;              { tcp }
  126.   IPPROTO_PUP        =  12;             { pup }
  127.   IPPROTO_UDP        =  17;             { user datagram protocol }
  128.   IPPROTO_IDP        =  22;             { xns idp }
  129.   IPPROTO_ND         =  77;             { UNOFFICIAL net disk proto }
  130.   IPPROTO_RAW        = 255;             { raw IP packet }
  131.   IPPROTO_MAX        = 256;
  132.  
  133.   { Port/socket numbers: network standard functions }
  134.   IPPORT_ECHO        =     7;
  135.   IPPORT_DISCARD     =     9;
  136.   IPPORT_SYSTAT      =     11;
  137.   IPPORT_DAYTIME     =     13;
  138.   IPPORT_NETSTAT     =     15;
  139.   IPPORT_FTP         =     21;
  140.   IPPORT_TELNET      =     23;
  141.   IPPORT_SMTP        =     25;
  142.   IPPORT_TIMESERVER  =     37;
  143.   IPPORT_NAMESERVER  =     42;
  144.   IPPORT_WHOIS       =     43;
  145.   IPPORT_MTP         =     57;
  146.  
  147.   { Port/socket numbers: host specific functions }
  148.   IPPORT_TFTP        =     69;
  149.   IPPORT_RJE         =     77;
  150.   IPPORT_FINGER      =     79;
  151.   IPPORT_TTYLINK     =     87;
  152.   IPPORT_SUPDUP      =     95;
  153.  
  154.   { UNIX TCP sockets }
  155.   IPPORT_EXECSERVER  =     512;
  156.   IPPORT_LOGINSERVER =     513;
  157.   IPPORT_CMDSERVER   =     514;
  158.   IPPORT_EFSSERVER   =     520;
  159.  
  160.   { UNIX UDP sockets }
  161.   IPPORT_BIFFUDP     =     512;
  162.   IPPORT_WHOSERVER   =     513;
  163.   IPPORT_ROUTESERVER =     520;
  164.  
  165.   { Ports < IPPORT_RESERVED are reserved for privileged processes (e.g. root) }
  166.   IPPORT_RESERVED    =     1024;
  167.  
  168.   { Link numbers }
  169.   IMPLINK_IP         =     155;
  170.   IMPLINK_LOWEXPER   =     156;
  171.   IMPLINK_HIGHEXPER  =     158;
  172.  
  173.   INVALID_SOCKET     =     $ffff;
  174.   SOCKET_ERROR       =     (-1);
  175.  
  176.   { Types }
  177.   SOCK_STREAM        =  1;              { stream socket }
  178.   SOCK_DGRAM         =  2;              { datagram socket }
  179.   SOCK_RAW           =  3;              { raw-protocol interface }
  180.   SOCK_RDM           =  4;              { reliably-delivered message }
  181.   SOCK_SEQPACKET     =  5;              { sequenced packet stream }
  182.  
  183.   { Option flags per-socket }
  184.   SO_DEBUG           =  $0001;         { turn on debugging info recording }
  185.   SO_ACCEPTCONN      =  $0002;         { socket has had listen() }
  186.   SO_REUSEADDR       =  $0004;         { allow local address reuse }
  187.   SO_KEEPALIVE       =  $0008;         { keep connections alive }
  188.   SO_DONTROUTE       =  $0010;         { just use interface addresses }
  189.   SO_BROADCAST       =  $0020;         { permit sending of broadcast msgs }
  190.   SO_USELOOPBACK     =  $0040;         { bypass hardware when possible }
  191.   SO_LINGER          =  $0080;         { linger on close if data present }
  192.   SO_OOBINLINE       =  $0100;         { leave received OOB data in line }
  193.   SO_DONTLINGER      = (not SO_LINGER);
  194.  
  195.  { Additional options }
  196.   SO_SNDBUF          =  $1001;         { send buffer size }
  197.   SO_RCVBUF          =  $1002;         { receive buffer size }
  198.   SO_SNDLOWAT        =  $1003;         { send low-water mark }
  199.   SO_RCVLOWAT        =  $1004;         { receive low-water mark }
  200.   SO_SNDTIMEO        =  $1005;         { send timeout }
  201.   SO_RCVTIMEO        =  $1006;         { receive timeout }
  202.   SO_ERROR           =  $1007;         { get error status and clear }
  203.   SO_TYPE            =  $1008;         { get socket type }
  204.  
  205.  
  206.   { TCP options }
  207.   TCP_NODELAY        =  $0001;
  208.  
  209.   { Address families }
  210.   AF_UNSPEC          =  0;              { unspecified }
  211.   AF_UNIX            =  1;              { local to host (pipes, portals) }
  212.   AF_INET            =  2;              { internetwork: UDP, TCP, etc. }
  213.   AF_IMPLINK         =  3;              { arpanet imp addresses }
  214.   AF_PUP             =  4;              { pup protocols: e.g. BSP }
  215.   AF_CHAOS           =  5;              { mit CHAOS protocols }
  216.   AF_NS              =  6;              { XEROX NS protocols }
  217.   AF_ISO             =  7;               { ISO protocols }
  218.   AF_OSI             =  AF_ISO;         { OSI is ISO }
  219.   AF_ECMA            =  8;              { european computer manufacturers }
  220.   AF_DATAKIT         =  9;              { datakit protocols }
  221.   AF_CCITT           =  10;             { CCITT protocols, X.25 etc }
  222.   AF_SNA             =  11;             { IBM SNA }
  223.   AF_DECnet          =  12;             { DECnet }
  224.   AF_DLI             =  13;             { Direct data link interface }
  225.   AF_LAT             =  14;             { LAT }
  226.   AF_HYLINK          =  15;             { NSC Hyperchannel }
  227.   AF_APPLETALK       =  16;             { AppleTalk }
  228.   AF_NETBIOS         =  17;             { NetBios-style addresses }
  229.   AF_MAX             =  18;
  230.  
  231.   { Protocol families, same as address families for now }
  232.   PF_UNSPEC          =  AF_UNSPEC;
  233.   PF_UNIX            =  AF_UNIX;
  234.   PF_INET            =  AF_INET;
  235.   PF_IMPLINK         =  AF_IMPLINK;
  236.   PF_PUP             =  AF_PUP;
  237.   PF_CHAOS           =  AF_CHAOS;
  238.   PF_NS              =  AF_NS;
  239.   PF_ISO             =  AF_ISO;
  240.   PF_OSI             =  AF_OSI;
  241.   PF_ECMA            =  AF_ECMA;
  242.   PF_DATAKIT         =  AF_DATAKIT;
  243.   PF_CCITT           =  AF_CCITT;
  244.   PF_SNA             =  AF_SNA;
  245.   PF_DECnet          =  AF_DECnet;
  246.   PF_DLI             =  AF_DLI;
  247.   PF_LAT             =  AF_LAT;
  248.   PF_HYLINK          =  AF_HYLINK;
  249.   PF_APPLETALK       =  AF_APPLETALK;
  250.   PF_MAX             =  AF_MAX;
  251.  
  252.  { Level number for (get/set)sockopt() to apply to socket itself }
  253.  SOL_SOCKET          = $ffff;          { options for socket level }
  254.  
  255.  { Maximum queue length specifiable by listen }
  256.  SOMAXCONN     =   5;
  257.  
  258.  MSG_OOB       =  $1;             { process out-of-band data }
  259.  MSG_PEEK      =  $2;             { peek at incoming message }
  260.  MSG_DONTROUTE =  $4;             { send without using routing tables }
  261.  
  262.  MSG_MAXIOVLEN =  16;
  263.  
  264.  { Define constant based on rfc883, used by gethostbyxxxx() calls }
  265.  MAXGETHOSTSTRUCT   =     1024;
  266.  
  267.  { Define flags to be used with the WSAAsyncSelect() call }
  268.  FD_READ       =  $01;
  269.  FD_WRITE      =  $02;
  270.  FD_OOB        =  $04;
  271.  FD_ACCEPT     =  $08;
  272.  FD_CONNECT    =  $10;
  273.  FD_CLOSE      =  $20;
  274.  
  275.  { All Windows Sockets error constants are biased by WSABASEERR fromthe normal }
  276.  WSABASEERR    =          10000;
  277.  
  278.  { Windows Sockets definitions of regular Microsoft C error constants }
  279.  WSAEINTR      =          (WSABASEERR+4);
  280.  WSAEBADF      =          (WSABASEERR+9);
  281.  WSAEACCES     =          (WSABASEERR+13);
  282.  WSAEFAULT     =          (WSABASEERR+14);
  283.  WSAEINVAL     =          (WSABASEERR+22);
  284.  WSAEMFILE     =          (WSABASEERR+24);
  285.  
  286.  { Windows Sockets definitions of regular Berkeley error constants }
  287.  WSAEWOULDBLOCK      =    (WSABASEERR+35);
  288.  WSAEINPROGRESS      =    (WSABASEERR+36);
  289.  WSAEALREADY         =    (WSABASEERR+37);
  290.  WSAENOTSOCK         =    (WSABASEERR+38);
  291.  WSAEDESTADDRREQ     =    (WSABASEERR+39);
  292.  WSAEMSGSIZE         =    (WSABASEERR+40);
  293.  WSAEPROTOTYPE       =    (WSABASEERR+41);
  294.  WSAENOPROTOOPT      =    (WSABASEERR+42);
  295.  WSAEPROTONOSUPPORT  =    (WSABASEERR+43);
  296.  WSAESOCKTNOSUPPORT  =    (WSABASEERR+44);
  297.  WSAEOPNOTSUPP       =    (WSABASEERR+45);
  298.  WSAEPFNOSUPPORT     =    (WSABASEERR+46);
  299.  WSAEAFNOSUPPORT     =    (WSABASEERR+47);
  300.  WSAEADDRINUSE       =    (WSABASEERR+48);
  301.  WSAEADDRNOTAVAIL    =    (WSABASEERR+49);
  302.  WSAENETDOWN         =    (WSABASEERR+50);
  303.  WSAENETUNREACH      =    (WSABASEERR+51);
  304.  WSAENETRESET        =    (WSABASEERR+52);
  305.  WSAECONNABORTED     =    (WSABASEERR+53);
  306.  WSAECONNRESET       =    (WSABASEERR+54);
  307.  WSAENOBUFS          =    (WSABASEERR+55);
  308.  WSAEISCONN          =    (WSABASEERR+56);
  309.  WSAENOTCONN         =    (WSABASEERR+57);
  310.  WSAESHUTDOWN        =    (WSABASEERR+58);
  311.  WSAETOOMANYREFS     =    (WSABASEERR+59);
  312.  WSAETIMEDOUT        =    (WSABASEERR+60);
  313.  WSAECONNREFUSED     =    (WSABASEERR+61);
  314.  WSAELOOP            =    (WSABASEERR+62);
  315.  WSAENAMETOOLONG     =    (WSABASEERR+63);
  316.  WSAEHOSTDOWN        =    (WSABASEERR+64);
  317.  WSAEHOSTUNREACH     =    (WSABASEERR+65);
  318.  WSAENOTEMPTY        =    (WSABASEERR+66);
  319.  WSAEPROCLIM         =    (WSABASEERR+67);
  320.  WSAEUSERS           =    (WSABASEERR+68);
  321.  WSAEDQUOT           =    (WSABASEERR+69);
  322.  WSAESTALE           =    (WSABASEERR+70);
  323.  WSAEREMOTE          =    (WSABASEERR+71);
  324.  
  325.  { Extended Windows Sockets error constant definitions }
  326.  WSASYSNOTREADY      =    (WSABASEERR+91);
  327.  WSAVERNOTSUPPORTED  =    (WSABASEERR+92);
  328.  WSANOTINITIALISED   =    (WSABASEERR+93);
  329.  
  330.  { Authoritative Answer: Host not found }
  331.  WSAHOST_NOT_FOUND   =    (WSABASEERR+1001);
  332.  HOST_NOT_FOUND      =    WSAHOST_NOT_FOUND;
  333.  
  334. { Non-Authoritative: Host not found, or SERVERFAIL }
  335.  WSATRY_AGAIN        =    (WSABASEERR+1002);
  336.  TRY_AGAIN           =    WSATRY_AGAIN;
  337.  
  338. { Non recoverable errors, FORMERR, REFUSED, NOTIMP }
  339.  WSANO_RECOVERY      =    (WSABASEERR+1003);
  340.  NO_RECOVERY         =    WSANO_RECOVERY;
  341.  
  342. { Valid name, no data record of requested type }
  343.  WSANO_DATA          =    (WSABASEERR+1004);
  344.  NO_DATA             =    WSANO_DATA;
  345.  
  346. { no address, look for MX record }
  347.  WSANO_ADDRESS       =    WSANO_DATA;
  348.  NO_ADDRESS          =    WSANO_ADDRESS;
  349.  
  350. { Windows Sockets errors redefined as regular Berkeley error constants }
  351.  EWOULDBLOCK         =    WSAEWOULDBLOCK;
  352.  EINPROGRESS         =    WSAEINPROGRESS;
  353.  EALREADY            =    WSAEALREADY;
  354.  ENOTSOCK            =    WSAENOTSOCK;
  355.  EDESTADDRREQ        =    WSAEDESTADDRREQ;
  356.  EMSGSIZE            =    WSAEMSGSIZE;
  357.  EPROTOTYPE          =    WSAEPROTOTYPE;
  358.  ENOPROTOOPT         =    WSAENOPROTOOPT;
  359.  EPROTONOSUPPORT     =    WSAEPROTONOSUPPORT;
  360.  ESOCKTNOSUPPORT     =    WSAESOCKTNOSUPPORT;
  361.  EOPNOTSUPP          =    WSAEOPNOTSUPP;
  362.  EPFNOSUPPORT        =    WSAEPFNOSUPPORT;
  363.  EAFNOSUPPORT        =    WSAEAFNOSUPPORT;
  364.  EADDRINUSE          =    WSAEADDRINUSE;
  365.  EADDRNOTAVAIL       =    WSAEADDRNOTAVAIL;
  366.  ENETDOWN            =    WSAENETDOWN;
  367.  ENETUNREACH         =    WSAENETUNREACH;
  368.  ENETRESET           =    WSAENETRESET;
  369.  ECONNABORTED        =    WSAECONNABORTED;
  370.  ECONNRESET          =    WSAECONNRESET;
  371.  ENOBUFS             =    WSAENOBUFS;
  372.  EISCONN             =    WSAEISCONN;
  373.  ENOTCONN            =    WSAENOTCONN;
  374.  ESHUTDOWN           =    WSAESHUTDOWN;
  375.  ETOOMANYREFS        =    WSAETOOMANYREFS;
  376.  ETIMEDOUT           =    WSAETIMEDOUT;
  377.  ECONNREFUSED        =    WSAECONNREFUSED;
  378.  ELOOP               =    WSAELOOP;
  379.  ENAMETOOLONG        =    WSAENAMETOOLONG;
  380.  EHOSTDOWN           =    WSAEHOSTDOWN;
  381.  EHOSTUNREACH        =    WSAEHOSTUNREACH;
  382.  ENOTEMPTY           =    WSAENOTEMPTY;
  383.  EPROCLIM            =    WSAEPROCLIM;
  384.  EUSERS              =    WSAEUSERS;
  385.  EDQUOT              =    WSAEDQUOT;
  386.  ESTALE              =    WSAESTALE;
  387.  EREMOTE             =    WSAEREMOTE;
  388.  
  389.  
  390. type
  391.   u_char = byte;
  392.   u_short = word;
  393.   u_int = word;
  394.   u_long = longint;
  395.   TSocket = u_int;
  396.   servent = record
  397.     s_name: PChar;
  398.     s_aliases: ^PChar;
  399.     s_port: integer;
  400.     s_proto: PChar;
  401.   end;
  402.   Pservent = ^servent;
  403.  
  404.   Protoent = record
  405.     p_name: PChar;
  406.     p_aliases: ^PChar;
  407.     p_proto: integer;
  408.   end;
  409.   Pprotoent = ^protoent;
  410.  
  411.   { some liberties taken with this structure }
  412.   in_addr = record
  413.     Case integer of
  414.     0: (s_net, s_host, s_lh, s_impno: u_char);
  415.     1: (s_w1,s_imp: u_short);
  416.     2: (s_addr: u_long);
  417.   end;
  418.   Pin_addr = ^in_addr;
  419.  
  420.   sockaddr_in = record
  421.     sin_family: integer;
  422.     sin_port: u_short;
  423.     sin_addr: in_addr;
  424.     sin_zero: array[0..7] of char;
  425.   end;
  426.   Psockaddr_in = ^sockaddr_in;
  427.  
  428.   hostent = record
  429.     h_name: PChar;
  430.     h_aliases: ^PChar;
  431.     h_addrtype: word;
  432.     h_length: word;
  433.     Case integer of
  434.     0: (h_addr_list: ^PChar);
  435.     1: (h_addr: ^pin_addr);
  436.   end;
  437.   Phostent = ^hostent;
  438.  
  439.   WSADATA = record
  440.     wVersion: word;
  441.     wHighVersion: word;
  442.     szDescription: array[0..WSADESCRIPTION_LEN] of char;
  443.     szSystemStatus: array[0..WSASYS_STATUS_LEN] of char;
  444.     iMaxSockets: u_short;
  445.     iMaxUdpDg: u_short;
  446.     lpVendorInfo: PChar;
  447.   end;
  448.  
  449.   sockaddr = record
  450.     sa_family: u_short;
  451.     sa_data: array[0..13] of char;
  452.   end;
  453.  
  454.   sockproto = record
  455.     sp_family: u_short;
  456.     sp_protocol: u_short;
  457.   end;
  458.  
  459.   linger = record
  460.     l_onoff: u_short;
  461.     l_linger: u_short;
  462.   end;
  463.  
  464.   TDataAvailable = procedure (Sender: TObject; Socket: TSocket) of object;
  465.   TSessionClosed = procedure (Sender: TObject; Socket: TSocket) of object;
  466.   TSessionAvailable = procedure (Sender: TObject; Socket: TSocket) of object;
  467.   TSessionConnected = procedure (Sender: TObject; Socket: TSocket) of object;
  468.  
  469.   TSockets = class(TWinControl)
  470.   private
  471.     Pse: Pservent;
  472.     Phe: Phostent;
  473.     Ppe: Pprotoent;
  474.     sin: sockaddr_in;
  475.     initdata: WSADATA;
  476.     FPort: String;
  477.     FIPAddr: String;
  478.     FSocket: TSocket;
  479.     FMSocket: TSocket;
  480.     FDataAvailable: TDataAvailable;
  481.     FSessionClosed: TSessionClosed;
  482.     FSessionAvailable: TSessionAvailable;
  483.     FSessionConnected: TSessionConnected;
  484.     procedure SetText(Text: string);
  485.     function GetText : string;
  486.     function SocketErrorDesc(error: integer) : string;
  487.     procedure SocketError(sockfunc: string);
  488.     procedure TWMPaint(var msg:TWMPaint); message WM_PAINT;
  489.   protected
  490.     procedure WMASyncSelect(var msg: TMessage); message WM_ASYNCSELECT;
  491.   public
  492.     constructor Create(AOwner: TComponent); override;
  493.     destructor Destroy; override;
  494.     { I'd like to call these methods Connect, Close, Listen, etc but
  495.       they would conflict with the WinSock.DLL function names ! }
  496.     procedure SConnect;
  497.     procedure SClose;
  498.     procedure SListen;
  499.     function SAccept: TSocket;
  500.     function SReceive(aSocket: TSocket; rlen: integer): string;
  501.     procedure SSend(aSocket: TSocket;Text: string; Len: integer);
  502.     function GetIPAddr: string;
  503.     function GetPort(aSocket: TSocket): string;
  504.   published
  505.     property Text: string read GetText write SetText;
  506.     property IPAddr: string read FIPAddr write FIPAddr;
  507.     property Port: string read FPort write FPort;
  508.     property SocketNumber: TSocket read FSocket;
  509.     property OnDataAvailable: TDataAvailable read FDataAvailable
  510.       write FDataAvailable;
  511.     property OnSessionClosed: TSessionClosed read FSessionClosed
  512.       write FSessionClosed;
  513.     property OnSessionAvailable: TSessionAvailable read FSessionAvailable
  514.       write FSessionAvailable;
  515.     property OnSessionConnected: TSessionConnected read FSessionConnected
  516.       write FSessionConnected;
  517.   end;
  518.  
  519. procedure Register;
  520.  
  521. implementation
  522.  
  523. { Function declarations for window's sockets (winsock)  This is a complete
  524.   set of function declarations for winsock, not all functions are called
  525.   from this component. }
  526. function accept(s: TSocket; var addr: sockaddr_in; var addrlen: integer) : TSocket;
  527.   far; external 'WINSOCK';
  528. function bind(s: TSocket; var addr: sockaddr_in; namelen: integer) : integer;
  529.   far; external 'WINSOCK';
  530. function closesocket(s: TSocket) : integer;
  531.   far; external 'WINSOCK';
  532. function connect(s: TSocket; var name: sockaddr_in; namelen: integer) : integer;
  533.   far; external 'WINSOCK';
  534. function ioctlsocket(s: TSocket; cmd: longint; var argp: longint) : integer;
  535.   far; external 'WINSOCK';
  536. function getpeername(s: TSocket; var name: sockaddr_in; var namelen: integer) :
  537.   integer; far; external 'WINSOCK';
  538. function getsockname(s: TSocket; var name: sockaddr_in; var namelen: integer) :
  539.   integer; far; external 'WINSOCK';
  540. function getsockopt(s: TSocket; level: integer; optname: integer;
  541.   optval: PChar; var optlen: integer) : integer; far; external 'WINSOCK';
  542. function htonl(hostlong: u_long) : u_long; far; external 'WINSOCK';
  543. function htons(hostshort: u_short) : u_short; far; external 'WINSOCK';
  544. function inet_addr(cp: PChar) : u_long; far; external 'WINSOCK';
  545. function inet_ntoa(sin: in_addr) : PChar; far; external 'WINSOCK';
  546. function listen(s: TSocket; backlog: integer) : integer;
  547.   far; external 'WINSOCK';
  548. function ntohl(netlong: u_long) : u_long; far; external 'WINSOCK';
  549. function ntohs(netshort: u_short) : u_short; far; external 'WINSOCK';
  550. function recv(s: TSocket; buf: PChar; len: integer; flags: integer) : integer;
  551.   far; external 'WINSOCK';
  552. function recvfrom(s: TSocket; buf: PChar; len: integer; flags: integer;
  553.   var from: sockaddr_in; var fromlen: integer) : integer; far; external 'WINSOCK';
  554. function send(s: TSocket; buf: PChar; len: integer; flags: integer) : integer;
  555.   far; external 'WINSOCK';
  556. function sendto(s: TSocket; buf: PChar; len: integer; flags: integer;
  557.   var saddrto: sockaddr_in; tolen: integer) : integer; far; external 'WINSOCK';
  558. function setsockopt(s: TSocket; level: integer; optname: integer; optval: PChar;
  559.   optlen: integer) : integer; far; external 'WINSOCK';
  560. function shutdown(s: TSocket; how: integer) : integer; far; external 'WINSOCK';
  561. function socket(af: integer; stype: integer; protocol: integer) : TSocket;
  562.   far; external 'WINSOCK';
  563. function gethostbyaddr(addr: PChar; len: integer; stype: integer) : phostent;
  564.   far; external 'WINSOCK';
  565. function gethostbyname(name: PChar) :  phostent; far; external 'WINSOCK';
  566. function gethostname(name: PChar) : integer; far; external 'WINSOCK';
  567. function getservbyport(port: integer; proto: PChar) : pservent;
  568.   far; external 'WINSOCK';
  569. function getservbyname(name: PChar; proto: PChar) : pservent;
  570.   far; external 'WINSOCK';
  571. function getprotobynumber(proto: integer) : pprotoent; far; external 'WINSOCK';
  572. function getprotobyname(name: PChar) : pprotoent; far; external 'WINSOCK';
  573. { Winsock extensions to Berkeley Sockets }
  574. function WSAStartup(wVersionRequired: word; var lpWSAData: WSADATA) : integer;
  575.   far; external 'WINSOCK';
  576. function WSACleanup : integer; far; external 'WINSOCK';
  577. procedure WSASetLastError(iError: integer); far; external 'WINSOCK';
  578. function WSAGetLastError : integer; far; external 'WINSOCK';
  579. function WSAIsBlocking : Boolean; far; external 'WINSOCK';
  580. function WSASetBlockingHook : integer; far; external 'WINSOCK';
  581. function WSACancelBlockingCall : integer; far; external 'WINSOCK';
  582. function WSAAsyncGetServByName(handle: HWND; wMsg: u_int; name: pChar;
  583.   proto: PChar; buf: PChar; buflen: integer) : THandle; far; external 'WINSOCK';
  584. function WSAAsyncGetServByPort(handle: HWND; wMsg: u_int; port: integer;
  585.   proto: PChar; buf: PChar; buflen: integer) : THandle; far; external 'WINSOCK';
  586. function WSAAsyncGetProtoByName(handle: HWND; wMsg: u_int; name: PChar;
  587.   buf: PChar; buflen: integer) : THandle; far; external 'WINSOCK';
  588. function WSAAsyncGetProtoByNumber(handle: HWND; wMsg: u_int; number: integer;
  589.   buf: PChar; buflen: integer) : THandle; far; external 'WINSOCK';
  590. function WSAAsyncGetHostByName(handle: HWND; wMsg: u_int; name: PChar;
  591.   buf: PChar; buflen: integer) : THandle; far; external 'WINSOCK';
  592. function WSAAsyncGetHostByAddr(handle: HWND; wMsg: u_int; addr: PChar;
  593.   len: integer; atype: integer; buf: PChar; buflen: integer) : THandle;
  594.   far; external 'WINSOCK';
  595. function WSACancelAsyncRequest(handle: THandle) :THandle;
  596.   far; external 'WINSOCK';
  597. function WSAAsyncSelect(s: TSocket; handle: HWND; wMsg: u_int; lEvent: longint)
  598.   : integer; far; external 'WINSOCK';
  599.  
  600. procedure Register;
  601. begin
  602.   RegisterComponents('Samples', [TSockets]);
  603. end;
  604.  
  605.  
  606. constructor TSockets.Create(AOwner: TComponent);
  607. var
  608.   iStatus: integer;
  609. begin
  610.   inherited Create(AOwner);
  611.   FPort := '';
  612.   FIPAddr := '';
  613.   FSocket := 0;
  614.   iStatus := WSAStartup($101,initdata);
  615.   if iStatus <> 0 then
  616.     SocketError('Constructor (WSAStartup)');
  617.   Invalidate;
  618. end;
  619.  
  620. destructor TSockets.Destroy;
  621. var
  622.   iStatus: integer;
  623. begin
  624.   iStatus := WSACleanup;
  625.   if iStatus < 0 then
  626.     SocketError('Destructor (WSACleanup)');
  627.   inherited Destroy;
  628. end;
  629.  
  630. procedure TSockets.TWMPaint(var msg: TWMPaint);
  631. var
  632.   icon: HIcon;
  633.   dc: HDC;
  634. begin
  635.   if csDesigning in ComponentState then
  636.   begin
  637.     icon := LoadIcon(HInstance,MAKEINTRESOURCE('TSOCKETS'));
  638.     dc := GetDC(Handle);
  639.     Width := 32;
  640.     Height := 32;
  641.     DrawIcon(dc,0,0,icon);
  642.     ReleaseDC(Handle,dc);
  643.     FreeResource(icon);
  644.   end;
  645.   ValidateRect(Handle,nil);
  646. end;
  647.  
  648. procedure TSockets.SetText(Text: string);
  649. var
  650.   iStatus: integer;
  651.   szBigBuff: array[0..256] of char;
  652.  
  653. begin
  654.   StrPCopy(szBigBuff,Text);
  655.   iStatus := send(FSocket,szBigBuff,StrLen(szBigBuff),0);
  656.   if iStatus < 0 then
  657.     SocketError('SetText (Send)');
  658. end;
  659.  
  660. function TSockets.GetText: string;
  661. var
  662.   len: integer;
  663.   BigBuff: string;
  664.   szBigBuff: array[0..256] of char absolute BigBuff;
  665.  
  666. begin
  667.   if FSocket <> 0 then
  668.   begin
  669.     len := recv(FSocket,@szBigBuff[1],255,0);
  670.     if len <= 0 then
  671.       SocketError('GetText (Recv)');
  672.     szBigBuff[0] := chr(len);
  673.     Result := BigBuff;
  674.   end
  675.   else Result := '';
  676. end;
  677.  
  678. function TSockets.GetPort(aSocket: TSocket): string;
  679. var
  680.   addr: sockaddr_in;
  681.   addrlen: integer;
  682.   port: integer;
  683. begin
  684.   addrlen := sizeof(addr);
  685.   getsockname(aSocket,addr,addrlen);
  686.   port := ntohs(addr.sin_port);
  687.   Result := Format('%d',[port]);
  688. end;
  689.  
  690. function TSockets.GetIPAddr: string;
  691. var
  692.   szAddr: array[0..31] of char;
  693.   addr: PChar;
  694. begin
  695.   addr := inet_ntoa(sin.sin_addr);
  696.   StrCopy(szAddr,addr);
  697.   Result := StrPas(szAddr);
  698. end;
  699.  
  700. function TSockets.SReceive(aSocket: TSocket; rlen: integer) : string;
  701. var
  702.   len: integer;
  703.   BigBuff: string;
  704.   szBigBuff: array[0..256] of char absolute BigBuff;
  705. begin
  706.   if FSocket <> 0 then
  707.   begin
  708.     len := recv(aSocket,@szBigBuff[1],rlen,0);
  709.     if len <= 0 then
  710.       SocketError('SReceive');
  711.     szBigBuff[0] := chr(len);
  712.     Result := BigBuff;
  713.   end
  714.   else Result := '';
  715. end;
  716.  
  717. procedure TSockets.SSend(aSocket: TSocket; Text: string; Len: integer);
  718. var
  719.   iStatus: integer;
  720.   szBigBuff: array[0..256] of char;
  721.  
  722. begin
  723.   StrPCopy(szBigBuff,Text);
  724.   iStatus := send(aSocket,szBigBuff,Len,0);
  725.   if iStatus < 0 then
  726.     SocketError('SSend');
  727. end;
  728.  
  729. procedure TSockets.WMASyncSelect(var msg: TMessage);
  730. begin
  731.   case LoWord(msg.lParam) of
  732.     FD_READ:
  733.     begin
  734.       if Assigned(FDataAvailable) then
  735.         FDataAvailable(Self,msg.wParam);
  736.     end;
  737.     FD_CLOSE:
  738.     begin
  739.       if Assigned(FSessionClosed) then
  740.         FSessionClosed(Self,msg.wParam);
  741.     end;
  742.     FD_ACCEPT:
  743.     begin
  744.       if Assigned(FSessionAvailable) then
  745.         FSessionAvailable(Self,msg.wParam);
  746.     end;
  747.     FD_CONNECT:
  748.     begin
  749.       if Assigned(FSessionConnected) then
  750.         FSessionConnected(Self,msg.wParam);
  751.     end;
  752.   end;
  753. end;
  754.  
  755. procedure TSockets.SConnect;
  756. var
  757.   iStatus: integer;
  758.   szTcp: PChar;
  759.   szPort: array[0..31] of char;
  760.   szData: array[0..256] of char;
  761. begin
  762.   if FPort = '' then
  763.   begin
  764.     Application.MessageBox('No Port Specified', 'WINSOCK ERROR', mb_OKCancel +
  765.       mb_DefButton1);
  766.     exit;
  767.   end;
  768.   if FIPAddr = '' then
  769.   begin
  770.     Application.MessageBox('No IP Address Specified', 'WINSOCK ERROR', mb_OKCancel +
  771.       mb_DefButton1);
  772.     exit;
  773.   end;
  774.   sin.sin_family := AF_INET;
  775.   StrPCopy(szPort,FPort);
  776.   szTcp := 'tcp';
  777.   Pse := getservbyname(szPort,szTcp);
  778.   if Pse = nil then
  779.      sin.sin_port := htons(StrToInt(StrPas(szPort)))
  780.   else sin.sin_port := Pse^.s_port;
  781.   StrPCopy(szData,FIPAddr);
  782.   sin.sin_addr.s_addr := inet_addr(szData);
  783.   if sin.sin_addr.s_addr = INADDR_NONE then
  784.     begin
  785.       Phe := gethostbyname(szData);
  786.       if Phe = nil then
  787.         begin
  788.           StrPCopy(szData,'Cannot convert host address');
  789.           Application.MessageBox(szData, 'WINSOCK ERROR', mb_OKCancel +
  790.              mb_DefButton1);
  791.           exit;
  792.         end;
  793.       sin.sin_addr := Phe^.h_addr^^;
  794.     end;
  795.   Ppe := getprotobyname(szTcp);
  796.   FSocket := socket(PF_INET,SOCK_STREAM,Ppe^.p_proto);
  797.   if FSocket < 0 then
  798.     SocketError('SConnect (socket)');
  799.   iStatus := WSAASyncSelect(FSocket,Handle,WM_ASYNCSELECT,
  800.      FD_READ or FD_CLOSE or FD_CONNECT);
  801.   if iStatus <> 0 then
  802.     SocketError('WSAAsyncSelect');
  803.   iStatus := connect(FSocket,sin,sizeof(sin));
  804.   if iStatus <> 0 then
  805.     begin
  806.     iStatus := WSAGetLastError;
  807.     if iStatus <> WSAEWOULDBLOCK then
  808.        SocketError('SConnect');
  809.     end;
  810. end;
  811.  
  812. procedure TSockets.SListen;
  813. var
  814.   iStatus: integer;
  815.   szTcp: PChar;
  816.   szPort: array[0..31] of char;
  817.   szData: array[0..256] of char;
  818. begin
  819.   if FPort = '' then
  820.   begin
  821.     Application.MessageBox('No Port Specified', 'WINSOCK ERROR', mb_OKCancel +
  822.       mb_DefButton1);
  823.     exit;
  824.   end;
  825.   sin.sin_family := AF_INET;
  826.   sin.sin_addr.s_addr := INADDR_ANY;
  827.   szTcp := 'tcp';
  828.   StrPCopy(szPort,FPort);
  829.   Pse := getservbyname(szPort,szTcp);
  830.   if Pse = nil then
  831.      sin.sin_port := htons(StrToInt(StrPas(szPort)))
  832.   else sin.sin_port := Pse^.s_port;
  833.   Ppe := getprotobyname(szTcp);
  834.   FMSocket := socket(PF_INET,SOCK_STREAM,Ppe^.p_proto);
  835.   if FMSocket < 0 then
  836.     SocketError('socket');
  837.   iStatus := bind(FMSocket, sin, sizeof(sin));
  838.   if iStatus <> 0 then
  839.     SocketError('Bind');
  840.   iStatus := listen(FMSocket,5);
  841.   if iStatus <> 0 then
  842.     SocketError('Listen');
  843.   iStatus := WSAASyncSelect(FMSocket,Handle,WM_ASYNCSELECT,
  844.      FD_READ or FD_ACCEPT or FD_CLOSE);
  845.   if iStatus <> 0 then
  846.     SocketError('WSAASyncSelect');
  847. end;
  848.  
  849. function TSockets.SAccept: TSocket;
  850. var
  851.   iStatus: integer;
  852.   len: integer;
  853. begin
  854.   len := sizeof(sin);
  855.   FSocket := accept(FMSocket,sin,len);
  856.   if FMSocket < 0 then
  857.     SocketError('Accept');
  858.   Result := FSocket;
  859. end;
  860.  
  861. procedure TSockets.SClose;
  862. var
  863.   iStatus: integer;
  864. begin
  865.   WSAASyncSelect(FSocket,Handle,WM_ASYNCSELECT,0);
  866.   iStatus := closesocket(FSocket);
  867.   if iStatus <> 0 then
  868.     SocketError('Disconnect (closesocket)');
  869.   FIPAddr := '';
  870.   FPort := '';
  871.   FSocket := 0;
  872. end;
  873.  
  874.  
  875. procedure TSockets.SocketError(sockfunc: string);
  876. var
  877.   szLine: array[0..255]  of char;
  878.   error: integer;
  879.   line: string;
  880. begin
  881.   error := WSAGetLastError;
  882.   line := 'Error '+ IntToStr(error) + ' in function ' + sockfunc +
  883.   #13#10 + SocketErrorDesc(error);
  884.   StrPCopy(szLine,line);
  885.   Application.MessageBox(szLine, 'WINSOCK ERROR', mb_OKCancel +
  886.     mb_DefButton1);
  887.   halt;
  888. end;
  889.  
  890. function TSockets.SocketErrorDesc(error: integer) : string;
  891. begin
  892.   case error of
  893.     WSAEINTR:
  894.       SocketErrorDesc := 'Interrupted system call';
  895.     WSAEBADF:
  896.       SocketErrorDesc := 'Bad file number';
  897.     WSAEACCES:
  898.       SocketErrorDesc := 'Permission denied';
  899.     WSAEFAULT:
  900.       SocketErrorDesc := 'Bad address';
  901.     WSAEINVAL:
  902.       SocketErrorDesc := 'Invalid argument';
  903.     WSAEMFILE:
  904.       SocketErrorDesc := 'Too many open files';
  905.     WSAEWOULDBLOCK:
  906.       SocketErrorDesc := 'Operation would block';
  907.     WSAEINPROGRESS:
  908.       SocketErrorDesc := 'Operation now in progress';
  909.     WSAEALREADY:
  910.       SocketErrorDesc := 'Operation already in progress';
  911.     WSAENOTSOCK:
  912.       SocketErrorDesc := 'Socket operation on non-socket';
  913.     WSAEDESTADDRREQ:
  914.       SocketErrorDesc := 'Destination address required';
  915.     WSAEMSGSIZE:
  916.       SocketErrorDesc := 'Message too long';
  917.     WSAEPROTOTYPE:
  918.       SocketErrorDesc := 'Protocol wrong type for socket';
  919.     WSAENOPROTOOPT:
  920.       SocketErrorDesc := 'Protocol not available';
  921.     WSAEPROTONOSUPPORT:
  922.       SocketErrorDesc := 'Protocol not supported';
  923.     WSAESOCKTNOSUPPORT:
  924.       SocketErrorDesc := 'Socket type not supported';
  925.     WSAEOPNOTSUPP:
  926.       SocketErrorDesc := 'Operation not supported on socket';
  927.     WSAEPFNOSUPPORT:
  928.       SocketErrorDesc := 'Protocol family not supported';
  929.     WSAEAFNOSUPPORT:
  930.       SocketErrorDesc := 'Address family not supported by protocol family';
  931.     WSAEADDRINUSE:
  932.       SocketErrorDesc := 'Address already in use';
  933.     WSAEADDRNOTAVAIL:
  934.       SocketErrorDesc := 'Can''t assign requested address';
  935.     WSAENETDOWN:
  936.       SocketErrorDesc := 'Network is down';
  937.     WSAENETUNREACH:
  938.       SocketErrorDesc := 'Network is unreachable';
  939.     WSAENETRESET:
  940.       SocketErrorDesc := 'Network dropped connection on reset';
  941.     WSAECONNABORTED:
  942.       SocketErrorDesc := 'Software caused connection abort';
  943.     WSAECONNRESET:
  944.       SocketErrorDesc := 'Connection reset by peer';
  945.     WSAENOBUFS:
  946.       SocketErrorDesc := 'No buffer space available';
  947.     WSAEISCONN:
  948.       SocketErrorDesc := 'Socket is already connected';
  949.     WSAENOTCONN:
  950.       SocketErrorDesc := 'Socket is not connected';
  951.     WSAESHUTDOWN:
  952.       SocketErrorDesc := 'Can''t send after socket shutdown';
  953.     WSAETOOMANYREFS:
  954.       SocketErrorDesc := 'Too many references: can''t splice';
  955.     WSAETIMEDOUT:
  956.       SocketErrorDesc := 'Connection timed out';
  957.     WSAECONNREFUSED:
  958.       SocketErrorDesc := 'Connection refused';
  959.     WSAELOOP:
  960.       SocketErrorDesc := 'Too many levels of symbolic links';
  961.     WSAENAMETOOLONG:
  962.       SocketErrorDesc := 'File name too long';
  963.     WSAEHOSTDOWN:
  964.       SocketErrorDesc := 'Host is down';
  965.     WSAEHOSTUNREACH:
  966.       SocketErrorDesc := 'No route to host';
  967.     WSAENOTEMPTY:
  968.       SocketErrorDesc := 'Directory not empty';
  969.     WSAEPROCLIM:
  970.       SocketErrorDesc := 'Too many processes';
  971.     WSAEUSERS:
  972.       SocketErrorDesc := 'Too many users';
  973.     WSAEDQUOT:
  974.       SocketErrorDesc := 'Disc quota exceeded';
  975.     WSAESTALE:
  976.       SocketErrorDesc := 'Stale NFS file handle';
  977.     WSAEREMOTE:
  978.       SocketErrorDesc := 'Too many levels of remote in path';
  979.     WSASYSNOTREADY:
  980.       SocketErrorDesc := 'Network sub-system is unusable';
  981.     WSAVERNOTSUPPORTED:
  982.       SocketErrorDesc := 'WinSock DLL cannot support this application';
  983.     WSANOTINITIALISED:
  984.       SocketErrorDesc := 'WinSock not initialized';
  985.     WSAHOST_NOT_FOUND:
  986.       SocketErrorDesc := 'Host not found';
  987.     WSATRY_AGAIN:
  988.       SocketErrorDesc := 'Non-authoritative host not found';
  989.     WSANO_RECOVERY:
  990.       SocketErrorDesc := 'Non-recoverable error';
  991.     WSANO_DATA:
  992.       SocketErrorDesc := 'No Data';
  993.     else SocketErrorDesc := 'Not a WinSock error';
  994.   end;
  995. end;
  996.  
  997. end.
  998.