Salut Steve Batson !
unit Tnsrv2;
interface
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, WSocket, Winsock;
const
 WM_DISCONNECT     = WM_USER + 2;
 DISCONNECT_SELF   = 1;
 DISCONNECT_REMOTE = 2;
type
  TClientForm = class(TForm)
    Memo: TMemo;
    DisconnectButton: TButton;
    DataEdit: TEdit;
    SendButton: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Display(Msg : String);
    procedure FormDestroy(Sender: TObject);
    procedure DisconnectButtonClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure SendButtonClick(Sender: TObject);
  private
    FCommand : String;
    procedure ProcessChar(Ch : Char);
  public
    Socket : TWSocket;
    AcceptForm : TForm;
    Reference : Pointer;
    procedure SocketDataAvailable(Sender: TObject; Error : word);
    procedure SocketSessionClosed(Sender: TObject; Error : word);
  end;
var
  ClientForm: TClientForm;
implementation
{$R *.DFM}
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{$IFNDEF WIN32}
procedure SetLength(var Str : String; Len : Integer);
begin
    Str[0] := chr(Len);
end;
{$ENDIF}
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TClientForm.FormCreate(Sender: TObject);
begin
    Memo.Clear;
    Socket                    := TWSocket.Create(Self);
    Socket.Parent             := Self;
    Socket.Top                := ClientHeight - Socket.Height - 4;
    Socket.OnDataAvailable    := SocketDataAvailable;
    Socket.OnSessionClosed    := SocketSessionClosed;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TClientForm.Display(Msg : String);
var
    Start, Stop : Integer;
    SelStart : Integer;
begin
    if Memo.Lines.Count = 0 then
        Memo.Lines.Add('');
    Start := 1;
    Stop  := Pos(#13, Msg);
    if Stop = 0 then
        Stop := Length(Msg) + 1;
    while Start <= Length(Msg) do begin
        Memo.Lines.Strings[Memo.Lines.Count - 1] := 
Memo.Lines.Strings[Memo.Lin
es.Count - 1] + Copy(Msg, Start, Stop - Start);
        if Msg[Stop] = #13 then begin
            SelStart := Memo.SelStart;
            Memo.Lines.Add('');
            Memo.SelStart := SelStart + 2;
{            SendMessage(Memo.Handle, WM_KEYDOWN, VK_UP, 1); }
        end;
        Start := Stop + 1;
        if Start > Length(Msg) then
            Break;
        if Msg[Start] = #10 then
           Start := Start + 1;
        Stop := Start;
        while (Msg[Stop]  #13) and (Stop <= Length(Msg)) do
            Stop := Stop + 1;
    end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TClientForm.ProcessChar(Ch : Char);
var
    Buffer : String;
begin
    if Ch = #8 then begin
        if Length(FCommand) > 0 then begin
            SetLength(FCommand, Length(FCommand) - 1);
            Socket.SendStr(#8 + ' ' + #8);
        end
        else
            Socket.SendStr(#7);
        Exit;
    end
    else if Ch  #13 then begin
        { Echo to client }
{$IFNDEF WIN32}
        if Length(FCommand) = High(FCommand) then
            Ch := #7
        else
{$ENDIF}
            FCommand := FCommand + Ch;
        Socket.Send(@Ch, 1);
        Exit;
    end;
    { Process Command }
    Socket.SendStr(#13 + #10 + 'Executing command ''' + FCOmmand + '''...' +
                   #13 + #10 + '--> ');
    FCommand := '';
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TClientForm.SocketDataAvailable(Sender: TObject; Error : word);
var
    Len    : Integer;
    Buffer : String[255];
    Socket : TWSocket;
    I      : Integer;
begin
    Socket := Sender as TWSocket;
    Len := Socket.Receive(@Buffer[1], High(Buffer));
    if Len = 0 then begin
        { Remote has closed }
        Display(#13 + #10 + '**** Remote has closed ****' + #13 + #10);
    end
    else if Len < 0 then begin
        { An error has occured }
        if Socket.LastError  WSAEWOULDBLOCK then
            Display(#13 + #10 + '**** ERROR: ' + IntToStr(Socket.LastError) +
                    ' ****' + #13 + #10);
    end
    else begin
        Buffer[0] := chr(Len);
        Display(Buffer);
        for I := 1 to Len do
            ProcessChar(Buffer[I]);
    end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TClientForm.SocketSessionClosed(Sender: TObject; Error : word);
begin
    Display(#13 + #10 + '**** Remote has closed ****' + #13 + #10);
    PostMessage(AcceptForm.Handle, WM_DISCONNECT,
                                   DISCONNECT_REMOTE,
                                   LongInt(Reference));
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TClientForm.FormDestroy(Sender: TObject);
begin
    Socket.Shutdown(2);
    Socket.Close;
    Socket.Free;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TClientForm.DisconnectButtonClick(Sender: TObject);
begin
    PostMessage(AcceptForm.Handle, WM_DISCONNECT,
                                   DISCONNECT_SELF,
                                   LongInt(Reference));
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TClientForm.FormShow(Sender: TObject);
var
    Buf : String;
begin
    Buf := 'Hello from TnSrv !' + #13 + #10 + '--> ';
    Socket.Send(@Buf[1], Length(Buf));
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TClientForm.SendButtonClick(Sender: TObject);
var
    Buf : String;
begin
    Buf := DataEdit.Text + #13 + #10;
    Socket.Send(@Buf[1], Length(Buf));
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
end.
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
Amiti‚s,
{-Francois Piette-}
--- SvFido 1.32
---------------