unit Utestlib;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  ComObj, ActiveX, testlib_TLB, StdVcl, Dialogs, WinSock, SysUtils, Windows;

type
  TApp = class(TAutoObject, IApp)
  protected
    procedure OpenSocket; safecall;
end;

type
 ThreadData = record
   Socket: TSocket;
 end;
 PThreadData = ^ThreadData;

var
 WSAData: TWSAData;
 ListenSocket, ClientSocket: TSocket;
 Info: PThreadData;
 SockAddr: TSockAddr;
 ThreadId: THandle;
 hClientThread: Thandle;

 Arg : u_long;
 s: TSocket;
const
 Port = word( 5555 );

implementation

uses ComServ;
//////////////////////////////////////////
procedure SocketThread(Info: PThreadData);
var
 SockName: TSockAddr;
 NameLen, OptLen: Integer;
 buf : array[ 0 .. 35 ] of byte;
 RecvSize: integer;

 BuffSize,k: integer;
 str : string;
 error : integer;

begin
 s := Info^.Socket;
 try
   NameLen := SizeOf(TSockAddr);
   if GetPeerName(s, SockName, NameLen) <>  0  then exit;
   ShowMessage('Client accepted');
   OptLen := SizeOf(BuffSize);
   if GetSockOpt(s, SOL_SOCKET, SO_RCVBUF, pointer(@BuffSize), OptLen) <>  0  then exit;
   try
     repeat
       RecvSize := recv(s, Buf[ 0 ], Length(Buf),  0 );
       if  RecvSize = SOCKET_ERROR then
          Begin
            error := WSAGetLastError();
            if (error<>WSAEWOULDBLOCK) then
                continue
            else RecvSize :=  1 
          end
       else
       sleep( 5 );
       if RecvSize >  1  then
          ShowMessage('Received from client ...');
     until RecvSize <=  0 ;
   finally
 end;
   ShowMessage('Client disconnected ...');
 finally
   CloseSocket(s);
   Dispose(Info);
 end;
end;
//////////////////////////////////////////

procedure TApp.OpenSocket;
begin
 ShowMessage('WSA Initialize ...');
 if WSAStartup($ 101 , WSAData) <>  0  then exit;
 try
   ListenSocket := socket(AF_INET, SOCK_STREAM, IPPROTO_IP);
   // non bloking
    Arg:= 1 ;
    IOCtlSocket(ListenSocket,FIONBIO,Arg);
   //
   if ListenSocket = INVALID_SOCKET then exit;
   try
     FillChar(SockAddr, SizeOf(TSockAddr),  0 );
     SockAddr.sin_family := AF_INET;
     SockAddr.sin_port := htons(Port);
     SockAddr.sin_addr.S_addr := INADDR_ANY;
     if Bind(ListenSocket, SockAddr, SizeOf(TSockAddr)) <>  0  then exit;
       if listen(ListenSocket, SOMAXCONN) <>  0  then exit;
         repeat
            
           ClientSocket := accept(ListenSocket, nil, nil);
           if ClientSocket <> INVALID_SOCKET then
             begin
               New(Info);
               Info^.Socket := ClientSocket;
               hClientThread := BeginThread(nil,  0 , @SocketThread, Info,  0 , ThreadId);
               if hClientThread <>  0  then CloseHandle(hClientThread);
             end;
         until false;
   finally
   Arg:= 0 ;
   IOCtlSocket(ListenSocket,FIONBIO,Arg);
   CloseSocket(ListenSocket);
   end;
 finally
   WSACleanup;
 end;
end;

initialization
  TAutoObjectFactory.Create(ComServer, TApp, Class_App,
    ciMultiInstance, tmApartment);
end.