Salut Steve Batson !
Dans un message de Steve Batson dat‚ du 18 Aug 96  17:40:14 il ‚tait dit:
---------- WSocket.Pas part 1/5 -----------
unit Wsocket;
{
Author:     François PIETTE
Email:      2:293/2202@fidonet.org, fpiette@msn.com or BBS +32-41-651395
            (+32-4-365.13.95 starting from sept 14, 1996)
Creation:   April 1996
Object:     TWSocket class encapsulate the Windows Socket paradigm
Updates:
Jul 18, 1996  Move all low level socket to winsock to be Delphi 2.x 
ompatible
}
interface
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, SockBuf, Wait, WinSock;
const
 { Message we will use for WSAAsynchSelect }
 WM_ASYNCSELECT = WM_USER + 1;
{$IFDEF WIN32}
 winsocket = 'wsock32.dll';
{$ELSE}
 winsocket = 'winsock.dll';
{$ENDIF}
type
  ESocketException = class(Exception);
  TSocketState = (InvalidState,
                  Opened,     Bound,
                  Connecting, Connected,
                  Accepting,  Listening,
                  Closed);
  TDataAvailable    = procedure (Sender: TObject; Error : word) of object;
  TDataSent         = procedure (Sender: TObject; Error : word) of object;
  TSessionClosed    = procedure (Sender: TObject; Error : word) of object;
  TSessionAvailable = procedure (Sender: TObject; Error : word) of object;
  TSessionConnected = procedure (Sender: TObject; Error : word) of object;
  TChangeState      = procedure (Sender: TObject;
                                 OldState, NewState : TSocketState) of 
ject;
  TWSocket = class(TCustomControl)
  private
    initdata          : TWSADATA;
    sin               : TSockAddrIn;
    FPortAssigned     : Boolean;
    FAddrAssigned     : Boolean;
    FProtoAssigned    : Boolean;
    FProto            : integer;
    FAddrFormat       : Integer;
    FHSocket          : TSocket;
    FASocket          : TSocket;               { Accepeted socket  }
    FState            : TSocketState;
    FBufList          : TList;
    FDataAvailable    : TDataAvailable;
    FDataSent         : TDataSent;
    FSessionClosed    : TSessionClosed;
    FSessionAvailable : TSessionAvailable;
    FSessionConnected : TSessionConnected;
    FChangeState      : TChangeState;
    FWait             : TWait;
    FStateWaited      : TSocketState;
    FLastError        : Integer;
    FPaused           : Boolean;
    bMoreFlag         : Boolean;
    nMoreCnt          : Integer;
    nMoreMax          : Integer;
    bWrite            : Boolean;
    bAllSent          : Boolean;
    ReadLineBuffer    : String[255];
    ReadLineCount     : Integer;
    ReadLineFlag      : Boolean;
    FReadCount        : LongInt;
    procedure   SocketError(sockfunc: string);
    procedure   TWMPaint(var msg:TWMPaint); message WM_PAINT;
  protected
    procedure   WMASyncSelect(var msg: TMessage); message WM_ASYNCSELECT;
    function    LoadDll(FileName : PChar) : Boolean;
    procedure   ChangeState(NewState : TSocketState);
    procedure   TryToSend;
    procedure   ReadLineReceive;
    procedure   AssignDefaultValue;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure   Connect;
    procedure   Close;
    procedure   WaitForClose;
    function    Listen : Integer;
    function    Accept: TSocket;
    function    Receive(Buffer : Pointer; BufferSize: integer) : integer;
    function    Send(Data : Pointer; Len : Integer) : integer;
    function    SendStr(Str : String) : Integer;
    function    GetPeerAddr: string;
    function    GetPeerName(var Name : TSockAddrIn; NameLen : Integer) : 
intege
r;
    function    GetXPort: string;
    function    TimerIsSet(var tvp : TTimeVal) : Boolean;
    procedure   TimerClear(var tvp : TTimeVal);
    function    TimerCmp(var tvp : TTimeVal; var uvp : TTimeVal; IsEqual : 
Bool
ean) : Boolean;
    function    SocketErrorDesc(error: integer) : string;
    function    Wait(Timeout : integer; State : TSocketState) : Boolean;
{    procedure   CreateWaitForm; }
    procedure   ReadLine(Timeout : integer; var Buffer : String);
    procedure   ReadLineStart;
    procedure   SetAddr(InAddr : String);
    function    GetAddr : String;
    procedure   SetPort(Port : String);
    function    GetPort : String;
    procedure   SetProto(Proto : String);
    function    GetProto : String;
    function    GetHostByAddr(Addr : String) : PHostEnt;
    function    GetHostByName(Name : String) : PHostEnt;
    function    GetSockName(var saddr : TSockAddrIn; var saddrlen : Integer) 
: 
integer;
    function    HostName : String;
    procedure   Dup(NewHSocket : Tsocket);
    procedure   Shutdown(How : Integer);
    procedure   Pause;
    procedure   Resume;
  published
    property Addr : string                          read  GetAddr
                                                    write SetAddr;
    property Port : string                          read  GetPort
                                                    write SetPort;
    property Proto : String                         read  GetProto
                                                    write SetProto;
    property HSocket : TSocket                      read  FHSocket;
    property State : TSocketState                   read  FState;
    property ReadCount : LongInt                    read  FReadCount;
    property LastError : Integer                    read  FLastError;
    property OnDataAvailable : TDataAvailable       read  FDataAvailable
                                                    write FDataAvailable;
    property OnDataSent : TDataSent                 read  FDataSent
                                                    write FDataSent;
    property OnSessionClosed : TSessionClosed       read  FSessionClosed
                                                    write FSessionClosed;
    property OnSessionAvailable : TSessionAvailable read  FSessionAvailable
                                                    write FSessionAvailable;
    property OnSessionConnected : TSessionConnected read  FSessionConnected
                                                    write FSessionConnected;
    property OnChangeState : TChangeState           read  FChangeState
                                                    write FChangeState;
    property WaitCtrl : TWait                       read  FWait
                                                    write FWait;
  end;
procedure Register;
implementation
Const
    GSocketCount : integer = 0;
    DllHandle    : THandle = 0;
{
var
    DllAccept                   : TAccept;
    DllBind                     : TBind;
    DllCloseSocket              : TCloseSocket;
    DllConnect                  : TConnect;
    DllIoctlSocket              : TIoctlSocket;
    DllGetPeerName              : TGetPeerName;
    DllGetSockName              : TGetSockName;
    DllGetSockOpt               : TGetSockOpt;
    Dllhtonl                    : Thtonl;
    Dllhtons                    : Thtons;
    DllInet_addr                : Tinet_addr;
    DllInet_ntoa                : Tinet_ntoa;
    DllListen                   : TListen;
    Dllntohl                    : Tntohl;
    Dllntohs                    : Tntohs;
    DllRecv                     : TRecv;
    DllRecvFrom                 : TRecvFrom;
    DllSend                     : TSend;
    DllSendTo                   : TSendTo;
    DllSetSockOpt               : TSetSockOpt;
    DllShutdown                 : TShutdown;
    DllOpenSocket               : TOpenSocket;
    DllGetHostByAddr            : TGetHostByAddr;
    DllGetHostByName            : TGetHostByName;
    DllGetHostName              : TGetHostName;
    DllGetServByPort            : TGetServByPort;
    DllGetServByName            : TGetServByName;
    DllGetProtoByNumber         : TGetProtoByNumber;
    DllGetProtoByName           : TGetProtoByName;
    DllWSAStartup               : TWSAStartup;
    DllWSACleanup               : TWSACleanup;
    DllWSASetLastError          : TWSASetLastError;
    DllWSAGetLastError          : TWSAGetLastError;
    DllWSAIsBlocking            : TWSAIsBlocking;
    DllWSASetBlockingHook       : TWSASetBlockingHook;
    DllWSACancelBlockingCall    : TWSACancelBlockingCall;
    DllWSAAsyncGetServByName    : TWSAAsyncGetServByName;
    DllWSAAsyncGetServByPort    : TWSAAsyncGetServByPort;
    DllWSAAsyncGetProtoByName   : TWSAAsyncGetProtoByName;
    DllWSAAsyncGetProtoByNumber : TWSAAsyncGetProtoByNumber;
    DllWSAAsyncGetHostByName    : TWSAAsyncGetHostByName;
    DllWSAAsyncGetHostByAddr    : TWSAAsyncGetHostByAddr;
    DllWSACancelAsyncRequest    : TWSACancelAsyncRequest;
    DllWSAAsyncSelect           : TWSAAsyncSelect;
}
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure Register;
begin
  RegisterComponents('FPiette', [TWSocket]);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{$IFNDEF WIN32}
procedure SetLength(var S: string; NewLength: Integer);
begin
    S[0] := chr(NewLength);
end;
{$ENDIF}
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function atoi(value : string) : Integer;
var
    i : Integer;
begin
    Result := 0;
    i := 1;
    while (i <= Length(Value)) and (Value[i] = ' ') do
        i := i + 1;
    while (i = '0') and (Value[i] <= '9')do 
be
gin
        Result := Result * 10 + ord(Value[i]) - ord('0');
        i := i + 1;
    end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function IsDigit(Ch : Char) : Boolean;
begin
    Result := (ch >= '0') and (ch <= '9');
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function RTrim(Str : String) : String;
var
    i : Integer;
begin
    i := Length(Str);
    while (i > 0) and (Str[i] = ' ') do
        i := i - 1;
    Result := Copy(Str, 1, i);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function LTrim(Str : String) : String;
var
    i : Integer;
begin
    if Str[1]  ' ' then             { Petite optimisation: pas d'espace   }
        Result := Str
    else begin
        i := 1;
        while (i <= Length(Str)) and (Str[i] = ' ') do
            i := i + 1;
        Result := Copy(Str, i, Length(Str) - i + 1);
    end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function Trim(Str : String) : String;
begin
    Result := LTrim(Rtrim(Str));
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
------- End of WSocket.Pas Part 1/5 ------------
Amiti‚s,
{-Francois Piette-}
--- SvFido 1.32
---------------