program Project1;
{$mode objfpc}{$H+}
uses
Classes,
ssockets,
Generics.Collections;
type
{ TClientHandlerThread }
TClientHandlerThread = class(TThread)
private
FSocket: TSocketStream;
public
constructor Create(ASocket: TSocketStream);
procedure Execute; override;
end;
THandlerList = specialize TObjectList<TClientHandlerThread>;
{ TMyServer }
TMyServer = class(TInetServer)
private
FClients: THandlerList;
procedure ClientConnected(Sender: TObject; Data: TSocketStream);
public
constructor Create(const aHost: string; const APort: word;
AHAndler: TSocketHandler = nil);
destructor Destroy; override;
procedure WaitForClients(Terminate: Boolean);
end;
{ TClientHandlerThread }
constructor TClientHandlerThread.Create(ASocket: TSocketStream);
begin
FSocket := ASocket;
inherited Create(False);
end;
procedure TClientHandlerThread.Execute;
var
c: Char;
begin
// communicate with client via FSocket
while not Terminated do
begin
c := chr(FSocket.ReadByte);
Write(c);
end;
end;
{ TMyServer }
procedure TMyServer.ClientConnected(Sender: TObject; Data: TSocketStream);
var
ClientThread: TClientHandlerThread;
begin
ClientThread := TClientHandlerThread.Create(Data);
FClients.Add(ClientThread);
end;
constructor TMyServer.Create(const aHost: string; const APort: word;
AHAndler: TSocketHandler);
begin
inherited Create(aHost, APort, AHAndler);
FClients := THandlerList.Create;
OnConnect:=@ClientConnected;
end;
destructor TMyServer.Destroy;
begin
WaitForClients(True);
FClients.Free;
inherited Destroy;
end;
procedure TMyServer.WaitForClients(Terminate: Boolean);
var
Client: TClientHandlerThread;
begin
for Client in FClients do
begin
if Terminate then
Client.Terminate;
Client.WaitFor;
end;
end;
var
server: TMyServer;
begin
try
server := TMyServer.Create('0.0.0.0', 8090);
server.StartAccepting;
finally
server.Free;
end;
end.