Forum > Networking and Web Programming
Server with TBlockSocket
Warfley:
I don't know much about TBlockSocket, but if all you want is a simple TCP server, the TInetServer from the ssockets unit (part of the FCL shipped with the FPC) makes this really easy:
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---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.
michoux:
Thanks,
I found perfect example in lnet package.
Navigation
[0] Message Index
[*] Previous page