如何在多线程模式下实现Delphi Tserversocket

时间:2018-09-04 15:15:53

标签: multithreading sockets delphi

我想创建一个TCP / Server并以文本格式接收来自多个客户端的数据。数据长度不得超过1024个字符。 我正在使用以下代码,但我不确定这是我认为是最简单的方法(如myString = Socket.ReceiveText)的正确方法。 我期望大约100多个模拟连接。 我可以做些什么来改善它吗?

印地不是一个选择,我在 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;

1 个答案:

答案 0 :(得分:4)

尝试更多类似的方法:

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.