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.

ComObj, ActiveX, testlib_TLB, StdVcl, Dialogs

program Project1;
uses
 SysUtils,
 WinSock;

{$APPTYPE CONSOLE}
var Sockets:array of TSocket;
   Addr:TSockAddr;
   Data:TWSAData;
   Len,I,J:Integer;
   FDSet:TFDSet;
   arrBuf : array [0..35] of byte;
   Arg:u_long;
   tv : Ttimeval;

begin
 WSAStartup($101,Data);
 SetLength(Sockets,1);
 Sockets[0]:=Socket(AF_Inet,Sock_Stream,0);
 Addr.sin_family:=AF_Inet;
 Addr.sin_port:=HToNS(21001);
 Addr.sin_addr.S_addr:=InAddr_Any;
 FillChar(Addr.Sin_Zero,SizeOf(Addr.Sin_Zero),0);
 Bind(Sockets[0],Addr,SizeOf(TSockAddr));
 Listen(Sockets[0],SoMaxConn);
 while True do
  begin
   FD_Zero(FDSet);
   for I:=0 to High(Sockets) do
   Arg:=1;
   IOCtlSocket(Sockets[I],FIONBIO,Arg);
   FD_Set(Sockets[I],FDSet);

   tv.tv_sec := 5;
   tv.tv_usec := 0;

   Select(0,@FDSet,nil,nil,@tv);

   if FDSet.fd_count=0 then Continue;
   sleep(100);
   writeln('wait');
   
   I:=1;
   while I<=High(Sockets) do
    begin
     if FD_IsSet(Sockets[I],FDSet) then
      if Recv(Sockets[I],arrBuf, sizeOf(arrBuf),0) <=0 then
       begin
       
        writeln('disconnect, socket close');
        CloseSocket(Sockets[I]);
        for J:=I to High(Sockets)-1 do
         Sockets[J]:=Sockets[J+1];
        Dec(I);
        SetLength(Sockets,Length(Sockets)-1)
       end
      else
       begin
        writeln('Receive data');

       end;
     Inc(I)
    end;
   

   if FD_IsSet(Sockets[0],FDSet) then
    begin
   
     writeln('new client connected');
     SetLength(Sockets,Length(Sockets)+1);
     Len:=SizeOf(TSockAddr);
     Sockets[High(Sockets)]:=Accept(Sockets[0],@Addr,@Len)
    end
  end;
end.

FD_Set(Sockets[I],FDSet);

Arg:=1;
  IOCtlSocket(Sockets[I],FIONBIO,Arg);