Как реализовать Delphi Tserversocket в многопоточном режиме

Question

Хочу Создать TCP / сервер и получать данные от нескольких клиентов в текстовом формате. Длина данных никогда не превышает 1024 символов. Я использую следующий код, но я не уверен, что это правильный путь, я думаю, это может быть самый простой способ, как myString = Socket.ReceiveText Я ожидаю около 100+ симулировать соединения. Что-нибудь, что я могу сделать, чтобы сделать это лучше?

indy - это не выбор, и я работаю в 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.

вот второй пример. Я думаю, что для моих лекарств лучше

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;

Answer 1

Попробуйте что-нибудь еще подобное:

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.