unit MainServerA;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, WinSock;

type
  TfMain = class(TForm)
    GroupBox1: TGroupBox;
    lb: TListBox;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
  end;

  PServerInfo = ^TServerInfo;
  TServerInfo = record
    ServerName : string[200];
    ServerCode : DWORD;
  end;

  PSocket = ^TSocket;

var
  fMain: TfMain;
  SI    : TServerInfo;
  SIPtr : PServerInfo;
  ThreadID  : DWORD;
  Hlb : HWND;
  hThread : THandle;
  S : TSocket;

implementation

{$R *.dfm}

function ThreadFunc(Ptr: Pointer): LongInt;
var S : string;
begin
  recv(PSocket(Ptr)^, SIPtr^, SizeOf(SI), 0);
  S := 'Сервер: ' + SIPtr^.ServerName + '  |  Код: ' + IntToStr(SI.ServerCode) +
    '  |  Отримано: ' + DateTimeToStr(Now);
  SendMessage(Hlb, LB_ADDSTRING, 0, LPARAM(PChar(S)));
  closesocket(PSocket(Ptr)^);
end;

function CreateSocketAndListen(Ptr: Pointer): LongInt;
var AcceptedSock : TSocket;
    Addr : TSockAddr;
    Data : TWSAData;
    Len  : Integer;
    PAS  : PSocket;
begin
  SIPtr := @SI;

  WSAStartup($101, Data);
  S := Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
  Addr.sin_family := PF_INET;
  Addr.sin_port := htons(2212);
  Addr.sin_addr.S_addr := inet_addr('127.0.0.1');
  bind(S, Addr, SizeOf(TSockAddr));
  listen(S, SOMAXCONN);

  Len := SizeOf(TSockAddr);
  while true do begin
    AcceptedSock := accept(S, @Addr, @Len);
    if AcceptedSock <> INVALID_SOCKET then begin
      PAS := @AcceptedSock;
      hThread := BeginThread(nil, 0, @ThreadFunc, PAS, 0, ThreadID);
      CloseHandle(hThread);
    end;
  end;
end;

procedure TfMain.FormCreate(Sender: TObject);
var  CN       : PChar;
     CNSize   : DWORD;
begin
  CNSize := MAX_COMPUTERNAME_LENGTH + 1;
  GetMem(CN, CNSize);
  GetComputerName(CN, CNSize);
  Caption := Caption + ' :: ' + CN;
  FreeMem(CN, CNSize);

  Hlb := lb.Handle;
  BeginThread(nil, 0, @CreateSocketAndListen, nil, 0, ThreadID);
end;

procedure TfMain.FormDestroy(Sender: TObject);
begin
  closesocket(S);
  WSACleanup;
end;

end.
