unit uTestConn;

interface

uses
  Windows,
  WinSock,
  SysUtils,
  Classes;

type

  TTestConnState = (
    tcsBind,
    tcsConnect,
    tcsData,
    tcsClose
  );

  TTestConnection = class;

  TTestConnChangedEvent = procedure ( ASender: TTestConnection;
    AState: TTestConnState ) of object;

  TLogEvent = procedure( AError: Boolean; S: string ) of object;

  TTestConnection = class( TThread )
  private
    FPort      : Integer;
    FAddress   : string;
    FOnLog     : TLogEvent;
    FOnChange  : TTestConnChangedEvent;
    FLogError  : Boolean;
    FLogString : string;
    FState     : TTestConnState;

    procedure _LogString;
    procedure _ChangeState;

  protected
    procedure Execute; override;
    procedure LogString( AError: Boolean; S: string );
    procedure ChangeState( AState: TTestConnState );
  public
    constructor Create( AAddress: string; APort: Integer );
    property OnLog: TLogEvent read FOnLog write FOnLog;
    property OnChange: TTestConnChangedEvent read FOnChange write FOnChange;
    property Port: Integer read FPort;
  end;


implementation

constructor TTestConnection.Create( AAddress: string; APort: Integer );
begin
  inherited Create( True );
  FPort := APort;
  FAddress := AAddress;
end;

procedure TTestConnection._LogString;
begin
  if Assigned( FOnLog ) then FOnLog( FLogError, FLogString );
end;

procedure TTestConnection._ChangeState;
begin
  if Assigned( FOnChange ) then FOnChange( Self, FState );
end;

procedure TTestConnection.LogString( AError: Boolean; S: string );
begin
  FLogString := S;
  FLogError := AError;
  Synchronize( _LogString );
end;

procedure TTestConnection.ChangeState( AState: TTestConnState );
begin
  FState := AState;
  Synchronize( _ChangeState );
end;

procedure TTestConnection.Execute;
var
  Sock       : TSocket;
  LocalAddr  : TSockAddrIn;
  RemoteAddr : TSockAddrIn;
  Buf        : array[0..4000] of Byte;
  Temp       : Integer;
  RemainCount : Integer;
  Res         : Integer;

  procedure Log( AError: Boolean; AText: string );
  var
    S : string;
  begin
    S := Format( '[%-5.2f] [%5d -> %s:%-5d] %s',
      [ GetTickCount / 1000, ntohs( LocalAddr.sin_port ), FAddress, FPort, AText ] );
    LogString( AError, S );
  end;

begin
  Log( False, 'socket' );

  Sock := socket( AF_INET, SOCK_STREAM, 0 );
  if Sock = INVALID_SOCKET then
  begin
    Log( True, 'socket-- failed' );
    Abort;
//    RaiseLastOsError;
  end;

  try
    ChangeState( tcsBind );
    FillChar( LocalAddr, SizeOf( LocalAddr ), 0 );
    LocalAddr.sin_family := AF_INET;
    LocalAddr.sin_port := htons( 0 );
    LocalAddr.sin_addr.S_addr := INADDR_ANY;;

    Log( False, 'bind' );

    if bind( Sock, LocalAddr, SizeOf( LocalAddr ) ) = SOCKET_ERROR then
    begin
      Log( True, 'bind-- failed' );
      Abort;
//      RaiseLastOsError;
    end;

    Temp := SizeOf( LocalAddr );
    if getsockname( Sock, LocalAddr, Temp ) = SOCKET_ERROR then
    begin
      Log( True, 'getsockname failed' );
      Abort;
//      RaiseLastOsError;
    end;

    FillChar( RemoteAddr, SizeOf( RemoteAddr ), 0 );
    RemoteAddr.sin_family := AF_INET;
    RemoteAddr.sin_port := htons( FPort );
    RemoteAddr.sin_addr.S_addr := inet_addr( PChar( FAddress ) );

    ChangeState( tcsConnect );
    Log( False, 'connect' );

    if connect( Sock, RemoteAddr, SizeOf( RemoteAddr )) = SOCKET_ERROR then
    begin
      Log( True, 'connect-- failed' );
      Abort;
//    RaiseLastOsError;
    end;

    ChangeState( tcsData );

    send( Sock, Buf, SizeOf( Buf ), 0 );
    shutdown( Sock, SD_SEND );

    RemainCount := SizeOf( Buf );
    repeat
      Res := recv( Sock, Buf, SizeOf( Buf ), 0 );
      if Res = SOCKET_ERROR then Break;
      Dec( RemainCount, Res );
    until RemainCount <= 0;

  finally

    shutdown( Sock, SD_BOTH );
    ChangeState( tcsClose );
    Log( False, 'closesocket' );
    CloseSocket( Sock );
  end;
end;


end.
