How to Implement Delphi Tserversocket in Multithread mode

Question

I Want To create a TCP/Server and receive data from Multiple Clients in text Format.Data Length is never more than 1024 chars. I am using the follow code But i am not sure is the correct way i think sould be a easiest way like myString=Socket.ReceiveText I am excpecting around 100+ simulate connections. Is it anything i can to for make it better?

indy is not a choice and i am working in Delphi 5

    unit Unit1;

interface

uses
  ScktComp, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TForm1 = class(TForm)
    ServerSocket1: TServerSocket;
    procedure ServerSocket1ClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure ServerSocket1GetThread(Sender: TObject;
      ClientSocket: TServerClientWinSocket;
      var SocketThread: TServerClientThread);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TClientThread = class(TServerClientThread)
  private
    Received_text: string;
    fsocketStream: TWinsocketStream;
  public
    procedure ClientExecute; override;
  end;



var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TClientThread.ClientExecute;
var
  Data: array[0..1023] of char;
begin

inherited FreeOnTerminate := TRUE;

      fsocketStream := TWinSocketStream.Create(ClientSocket, 1000);
      try

  while not Terminated and ClientSocket.Connected do
    try

        FillChar(Data, SizeOf(Data), 0);
        try
          if fsocketStream.Read(Data, SizeOf(Data)) = 0 then
            begin
              ClientSocket.Close;
              Terminate;
            end;
        except
          ClientSocket.Close;
          Terminate;
        end;

        Received_text := Data;
     //Process Data HEre
     //process the data Like Read From SQL and Take actions Depence on data received
     //****************************************************************
        try ClientSocket.sendtext('Hello From MultiThread Server'); except end;

      finally
        fsocketStream.Free;

      end;
    except
      HandleException;
    end;



end;



procedure TForm1.ServerSocket1ClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  errorcode := 0;
end;

procedure TForm1.ServerSocket1GetThread(Sender: TObject;
  ClientSocket: TServerClientWinSocket;
  var SocketThread: TServerClientThread);
begin
  SocketThread := TClientThread.Create(False, ClientSocket);
end;

end.

here is a second Example. I think for my meeds is better

Received_text:=Received_text+clientsocket.ReceiveText;
if pos(#13#10,Received_text)>0 Then
begin
try clientsocket.SendText(#13#10+'REC='+Received_text+#10#13);except end;
Received_text:='';
end;

Hi, other users will need more information before they can help you here. "Is it anything i can to for make it better?" is not specific enough. What problems have you experienced? stackoverflow.com/help/how-to-ask is a useful guide to getting good results on SO. — ben author
– ben author, Commented Sep 4, 2018 at 15:22
"I am using the follow code But i am not sure is the correct way" - close, but you are making a couple of mistakes. Like dont create a new TWinSocketStream on each loop iteration. Create it once before entering the loop, free it after exiting the loop. "i think sould be a easiest way like myString=Socket.ReceiveText" - do not use ReceiveText. All it does is return whatever bytes are currently in the socket without regard to format or structure. TCP messages require structure, you need to code for that. "indy is not a choice and i am working in Delphi 5" - Indy supports Delphi 5. — Remy Lebeau
– Remy Lebeau, Commented Sep 4, 2018 at 15:25
thanks remy i corrected check teh second example this is without creating FsocketStream whats the wrong with this? I am going to have troubles in the feature if i use it? as i said users are sending plain text with LF on the end. I know abou indy i used them a lot but in real world tclientsocket and tserversocket its much better for my needs. — icinema gr
– icinema gr, Commented Sep 4, 2018 at 15:41
"as i said users are sending plain text with LF on the end" - actually, you DIDNT say that earlier. That is important information to know. Now we can make progress. Your best option is to use Socket.ReceiveBuf() to read incoming data into a buffer, and then you can scan that buffer for (CR)LF so you are processing only complete strings. "I know abou indy i used them a lot but in real world tclientsocket and tserversocket its much better for my needs" - doubtful, they don't offer anything that Indy doesn't. — Remy Lebeau
– Remy Lebeau, Commented Sep 4, 2018 at 21:46

Remy Lebeau · Accepted Answer · 2018-09-04 22:25:34Z

Try something more like this:

unit Unit1;

interface

uses
  ScktComp, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TForm1 = class(TForm)
    ServerSocket1: TServerSocket;
    procedure ServerSocket1ClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure ServerSocket1GetThread(Sender: TObject;
      ClientSocket: TServerClientWinSocket;
      var SocketThread: TServerClientThread);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  Winsock, RTLConsts;

{$R *.DFM}

type
  TClientThread = class(TServerClientThread)
  public
    procedure ClientExecute; override;
  end;

procedure TClientThread.ClientExecute;
var
  Data: array[0..1023] of AnsiChar;
  SocketStream: TWinSocketStream;
  Buffer, Received_text: AnsiString;
  NumRead, Len, Idx: Integer;

  procedure SendRaw(Buffer: Pointer; BufLen: Integer);
  var
    P: PByte;
    NumSent: Integer;
  begin
    // need to loop until all bytes are sent...
    P := PByte(Buffer);
    while BufLen > 0 do
    begin
      // TWinSocketStrea.Write() raises on failure, but returns 0 on timeout...
      NumSent := SocketStream.Write(P^, BufLen);
      if NumSent = 0 then
        raise ESocketError.CreateResFmt(@sSocketIOError, [sSocketWrite, WSAETIMEDOUT, SysErrorMessage(WSAETIMEDOUT)]);
      Inc(P, NumSent);
      Dec(BufLen, NumSent);
    end;
  end;

  procedure SendLine(const S: AnsiString);
  begin
    SendRaw(PAnsiChar(S), Length(S));
    SendRaw(PAnsiChar(#13#10), 2);
  end;

begin
  SocketStream := TWinSocketStream.Create(ClientSocket, 30000);
  try
    SendLine('Hello From MultiThread Server');

    while (not Terminated) and ClientSocket.Connected do
    begin
      // check if any new bytes have arrived...
      if not SocketStream.WaitForData(5000) then
        Continue;

      // TWinSocketStream.Read() raises on failure, and returns 0 on disconnect or timeout...
      NumRead := SocketStream.Read(Data, SizeOf(Data));
      if NumRead = 0 then
        Exit;

      // append new bytes to end of buffer...
      Len := Length(Buffer);
      SetLength(Buffer, Len + NumRead);
      Move(Data[0], @Buffer[Len+1], NumRead);

      // look for complete (CR)LF-delimited lines of text...
      repeat
        Idx := Pos(#10, Buffer);
        if Idx = 0 then Break; // not complete, wait for more bytes...

        Len := Idx-1;
        if (Len > 0) and (Buffer[Len-1] = #13) then
          Dec(Len); // ignore CR...

        Received_text := Copy(Buffer, 1, Len);
        Delete(Buffer, 1, Idx);

        //Process Received_text Here

        SendLine('REC=' + Str);
      until Buffer = '';
    end;
  finally
    SocketStream.Free;
  end;
end;

procedure TForm1.ServerSocket1ClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  ErrorCode := 0;
end;

procedure TForm1.ServerSocket1GetThread(Sender: TObject;
  ClientSocket: TServerClientWinSocket;
  var SocketThread: TServerClientThread);
begin
  SocketThread := TClientThread.Create(False, ClientSocket);
end;

end.

Any way to have an example for this code with indy idTcpServer 9 or 10 ver?
@icinemagr edit your question to say that Indy is now a possible choice, and then I'll update my answer to include Indy examples.

Collectives™ on Stack Overflow

How to Implement Delphi Tserversocket in Multithread mode

1 Answer 1

2 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

2 Comments

Your Answer

Sign up or log in

Post as a guest

Related