Recent

Author Topic: Server with TBlockSocket  (Read 1013 times)

michoux

  • New Member
  • *
  • Posts: 49
Server with TBlockSocket
« on: May 06, 2021, 02:28:36 pm »
Hello,
I have found some simple code in forum to start a simple server

Code: Pascal  [Select][+][-]
  1. procedure TForm1.Button3Click(Sender: TObject);
  2. begin
  3.  
  4.   listenersocket1:=TBlockSocket.Create;
  5.   listenersocket1.CreateSocket;                
  6.   listenersocket1.Bind('127.0.0.1'7000);  
  7.   listenersocket1.Listen;                        
  8.  
  9.   repeat                                          
  10.     Application.ProcessMessages;                
  11.       if listenersocket1.CanRead(10) then begin    
  12.         connection1:=TBlockSocket.Create;          
  13.         connection1.Socket:=listenersocket1.Accept;  
  14.         connected1:=true;
  15.  
  16.    
  17.       end;
  18.   until false;
  19. end;                                        
       


All ok, now I have problems because I want to connect 2 clients to this server, which is impossible :)
Is there any simple example with threads? I am not really familiar with threads in lazarus ....

I found a workaround to create 2 servers each client would connect to own server, if some message received on server A I can pass it to server B with  connection.SendString(message+CR+LF);                       
But somehow if both servers are working and client disconnects it can not get back any more to server.

Code: Pascal  [Select][+][-]
  1. procedure TForm1.Button3Click(Sender: TObject);
  2. begin
  3.  
  4.   listenersocket1:=TBlockSocket.Create;
  5.   listenersocket1.CreateSocket;                
  6.   listenersocket1.Bind('127.0.0.1',7000);  
  7.   listenersocket1.Listen;                        
  8.  
  9.   repeat                                          
  10.     Application.ProcessMessages;                
  11.       if listenersocket1.CanRead(10) then begin    
  12.         connection1:=TBlockSocket.Create;          
  13.         connection1.Socket:=listenersocket1.Accept;  
  14.         connected1:=true;  
  15.       end;
  16.   until false;
  17. end;                                        
  18.  
  19.  
  20. procedure TForm1.Button4Click(Sender: TObject);
  21. begin
  22.  
  23.   listenersocket:=TBlockSocket.Create;
  24.   listenersocket.CreateSocket;                
  25.   listenersocket.Bind('127.0.0.1',7001);  
  26.   listenersocket.Listen;                        
  27.  
  28.   repeat                                          
  29.     Application.ProcessMessages;                
  30.       if listenersocket.CanRead(10) then begin    
  31.         connection:=TBlockSocket.Create;          
  32.         connection.Socket:=listenersocket.Accept;  
  33.         connected:=true;
  34.       end;
  35.   until false;
  36. end;                                        
  37.  
  38.  
  39. procedure TForm1.Timer1Timer(Sender: TObject);
  40. begin
  41.    Application.ProcessMessages;            
  42.   if connected=true then begin
  43.       commessage:=connection.RecvString(10);
  44.       if mmessage<>'' then  begin
  45.       connection1.SendString(mmessage+CR+LF);
  46.  
  47.       end;
  48.     end;
  49. end;      
       

paweld

  • Sr. Member
  • ****
  • Posts: 291
Best regards
paweld

michoux

  • New Member
  • *
  • Posts: 49
Re: Server with TBlockSocket
« Reply #2 on: May 06, 2021, 03:28:51 pm »
nxPascal  is nice, but I can not connect to it from custom client, allways get timeout

<#1 Error(10060): Connection timed out>
<#1: Socket closed>


I did a simple test with telnet to pport
« Last Edit: May 06, 2021, 03:31:24 pm by michoux »

paweld

  • Sr. Member
  • ****
  • Posts: 291
Re: Server with TBlockSocket
« Reply #3 on: May 06, 2021, 04:16:23 pm »
clear Mask:
Code: Pascal  [Select][+][-]
  1. server.Mask := '';
Best regards
paweld

michoux

  • New Member
  • *
  • Posts: 49
Re: Server with TBlockSocket
« Reply #4 on: May 06, 2021, 04:55:36 pm »
Hmm
Still the same

<#2: Opened new socket>
<#2 Error(10060): Connection timed out>
<#2: Socket closed>

Warfley

  • Sr. Member
  • ****
  • Posts: 451
Re: Server with TBlockSocket
« Reply #5 on: May 06, 2021, 05:30:27 pm »
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  [Select][+][-]
  1. program Project1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. uses
  6.   Classes,
  7.   ssockets,
  8.   Generics.Collections;
  9.  
  10. type
  11.  
  12.   { TClientHandlerThread }
  13.  
  14.   TClientHandlerThread = class(TThread)
  15.   private
  16.     FSocket: TSocketStream;
  17.   public
  18.     constructor Create(ASocket: TSocketStream);
  19.     procedure Execute; override;
  20.   end;
  21.   THandlerList = specialize TObjectList<TClientHandlerThread>;
  22.  
  23.   { TMyServer }
  24.  
  25.   TMyServer = class(TInetServer)
  26.   private
  27.     FClients: THandlerList;
  28.     procedure ClientConnected(Sender: TObject; Data: TSocketStream);
  29.   public
  30.     constructor Create(const aHost: string; const APort: word;
  31.       AHAndler: TSocketHandler = nil);
  32.     destructor Destroy; override;
  33.     procedure WaitForClients(Terminate: Boolean);
  34.   end;
  35.  
  36.   { TClientHandlerThread }
  37.  
  38.   constructor TClientHandlerThread.Create(ASocket: TSocketStream);
  39.   begin
  40.     FSocket := ASocket;
  41.     inherited Create(False);
  42.   end;
  43.  
  44.   procedure TClientHandlerThread.Execute;
  45.   var
  46.     c: Char;
  47.   begin
  48.     // communicate with client via FSocket
  49.     while not Terminated do
  50.     begin
  51.       c := chr(FSocket.ReadByte);
  52.       Write(c);
  53.    end;
  54.   end;
  55.  
  56.   { TMyServer }
  57.  
  58. procedure TMyServer.ClientConnected(Sender: TObject; Data: TSocketStream);
  59. var
  60.   ClientThread: TClientHandlerThread;
  61. begin
  62.   ClientThread := TClientHandlerThread.Create(Data);
  63.   FClients.Add(ClientThread);
  64. end;
  65.  
  66.   constructor TMyServer.Create(const aHost: string; const APort: word;
  67.     AHAndler: TSocketHandler);
  68.   begin
  69.     inherited Create(aHost, APort, AHAndler);
  70.     FClients := THandlerList.Create;
  71.     OnConnect:=@ClientConnected;
  72.   end;
  73.  
  74.   destructor TMyServer.Destroy;
  75.   begin
  76.     WaitForClients(True);
  77.     FClients.Free;
  78.     inherited Destroy;
  79.   end;
  80.  
  81.     procedure TMyServer.WaitForClients(Terminate: Boolean);
  82.   var
  83.     Client: TClientHandlerThread;
  84.   begin
  85.     for Client in FClients do
  86.     begin
  87.       if Terminate then
  88.         Client.Terminate;
  89.       Client.WaitFor;
  90.     end;
  91.   end;
  92.  
  93. var
  94.   server: TMyServer;
  95.  
  96. begin
  97.   try
  98.     server := TMyServer.Create('0.0.0.0', 8090);
  99.     server.StartAccepting;
  100.   finally
  101.     server.Free;
  102.   end;
  103. end.

michoux

  • New Member
  • *
  • Posts: 49
Re: Server with TBlockSocket
« Reply #6 on: May 06, 2021, 09:26:50 pm »
Thanks,

I found perfect example in lnet package.

 

TinyPortal © 2005-2018