Question

您好，我有来自此链接How to continuously send messages with TIdTCPServer?的代码，但我无法使其正常工作。我想要多接受服务器，它将接受客户symultaniosly。代码在这里：

    unit UnitClientServer;

interface

uses
  IdCustomTCPServer, IdTCPClient, IdContext,
  SysUtils, Classes, Forms, StdCtrls, Controls, System.Actions, Vcl.ActnList;

type
  TMyPushClientThread = class(TThread)
  private
    TCPClient: TIdTCPClient;
    FLog: TStrings;
  public
    constructor Create(AHost: string; APort: Word; ALog: TStrings);
    destructor Destroy; override;
    procedure Execute; override;
  end;

  TMyPushServer = class (TIdCustomTCPServer)
  protected
    function DoExecute(AContext: TIdContext): Boolean; override;
  end;

  TServerPushExampleForm = class(TForm)
    MemoLog: TMemo;

    aclMain: TActionList;
    Button1: TButton;
    actStartClient: TAction;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure actStartClientExecute(Sender: TObject);

  private
    ExampleClient: TMyPushClientThread;
    ExampleServer: TMyPushServer;
  end;

var
  ServerPushExampleForm: TServerPushExampleForm;

implementation

uses
  IdGlobal;

{$R *.dfm}

procedure TServerPushExampleForm.actStartClientExecute(Sender: TObject);

var myTstring : TStrings;

begin
     //FreeAndNil(ExampleClient);

     myTstring := TStringList.Create;
     myTstring.Add('My log');


     ExampleClient:= TMyPushClientThread.Create('localhost', 8088, myTstring)  ;
     ExampleClient.Execute;

end;



procedure TServerPushExampleForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
     // MainWindow.actServer.Enabled := True;
end;

procedure TServerPushExampleForm.FormCreate(Sender: TObject);
begin
  ExampleServer := TMyPushServer.Create;
  ExampleServer.DefaultPort := 8088;
  ExampleServer.Active := True;


  ExampleClient := TMyPushClientThread.Create('localhost', 8088, MemoLog.Lines);
end;

procedure TServerPushExampleForm.FormDestroy(Sender: TObject);
begin
  ExampleServer.Free;
  ExampleClient.Terminate;
  ExampleClient.WaitFor;
  ExampleClient.Free;
end;

{ TMyPushServer }

function TMyPushServer.DoExecute(AContext: TIdContext): Boolean;
begin
  Result := inherited;

  // simulate hard work
  Sleep(Random(3000));

  AContext.Connection.IOHandler.WriteLn(
    'Completed at ' + TimeToStr(Now), TIdTextEncoding.UTF8 );
end;

{ TMyPushClientThread }

constructor TMyPushClientThread.Create(AHost: string; APort: Word; ALog: TStrings);
begin
  inherited Create(False);

  FLog := ALog;

  TCPClient := TIdTCPClient.Create;
  TCPClient.Host := AHost;
  TCPClient.Port := APort;
  TCPClient.ReadTimeout := 500;
end;

destructor TMyPushClientThread.Destroy;
begin
  TCPClient.Free;
  inherited;
end;

procedure TMyPushClientThread.Execute;
var
  S: string;
begin
  TCPClient.Connect;

  while not Terminated do
  begin
    S := TCPClient.IOHandler.ReadLn(TIdTextEncoding.UTF8 );

    if not TCPClient.IOHandler.ReadLnTimedout then
    begin
      TThread.Queue(nil,
        procedure
        begin
          FLog.Append(S);
        end);
    end;

  end;

  TCPClient.Disconnect;
end;

end.

执行此功能时：

    procedure TServerPushExampleForm.actStartClientExecute(Sender: TObject);

var myTstring : TStrings;

begin
     //FreeAndNil(ExampleClient);

     myTstring := TStringList.Create;
     myTstring.Add('My log');


     ExampleClient:= TMyPushClientThread.Create('localhost', 8088, myTstring)  ;
     ExampleClient.Execute;

end;

我有这个错误：

请帮助我希望服务器接受来自客户端的连接并将消息接收到备忘录。

Answer 1

尝试更像这样的事情：

unit UnitClientServer;

interface

uses
  IdCustomTCPServer, IdTCPClient, IdContext,
  SysUtils, Classes, Forms, StdCtrls, Controls, System.Actions, Vcl.ActnList;

type
  TMyPushClientThread = class(TThread)
  private
    TCPClient: TIdTCPClient;
    FLog: TStrings;
    FFreeLog: Boolean;
  protected
    procedure Execute; override;
  public
    constructor Create(AHost: string; APort: Word; ALog: TStrings; AFreeLog: Boolean);
    destructor Destroy; override;
  end;

  TMyPushServer = class (TIdCustomTCPServer)
  protected
    procedure DoConnect(AContext: TIdContext); override;
    function DoExecute(AContext: TIdContext): Boolean; override;
  end;

  TServerPushExampleForm = class(TForm)
    MemoLog: TMemo;
    aclMain: TActionList;
    Button1: TButton;
    actStartClient: TAction;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure actStartClientExecute(Sender: TObject);
  private
    ExampleServer: TMyPushServer;
    ExampleClients: TList;
  end;

var
  ServerPushExampleForm: TServerPushExampleForm;

implementation

uses
  IdGlobal;

{$R *.dfm}

procedure TServerPushExampleForm.actStartClientExecute(Sender: TObject);
var
  Client: TMyPushClientThread;
  myTstring : TStringList;
begin
  myTstring := TStringList.Create;
  try
    myTstring.Add('My log');
    Client := TMyPushClientThread.Create('localhost', 8088, myTstring, True);
  except
    myTstring.Free;
    raise;
  end;

  try
    ExampleClients.Add(Client);
  except
    Client.Free;
    raise;
  end;

  Client.Start;
end;

procedure TServerPushExampleForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  // MainWindow.actServer.Enabled := True;
end;

procedure TServerPushExampleForm.FormCreate(Sender: TObject);
var
  Client: TMyPushClientThread;
begin
  ExampleServer := TMyPushServer.Create(Self);
  ExampleServer.DefaultPort := 8088;
  ExampleServer.Active := True;

  ExampleClients := TList.Create;

  Client := TMyPushClientThread.Create('localhost', 8088, MemoLog.Lines, False);
  try
    ExampleClients.Add(Client);
  except
    Client.Free;
    raise;
  end;

  Client.Start;
end;

procedure TServerPushExampleForm.FormDestroy(Sender: TObject);
var
  Client: TMyPushClientThread;
  I: Integer;
begin
  if Assigned(ExampleClients) then
  begin
    for I := 0 to ExampleClients.Count-1 do
    begin
      Client := TMyPushClientThread(ExampleClients[I]);
      Client.Terminate;
      Client.WaitFor;
      Client.Free;
    end;
    ExampleClients.Free;
  end;

  ExampleServer.Active := False;
end;

{ TMyPushServer }

procedure TMyPushServer.DoConnect(AContext: TIdContext);
begin
  inherited;
  AContext.Connection.IOHandler.DefStringEncoding := TIdTextEncoding.UTF8;
end;

function TMyPushServer.DoExecute(AContext: TIdContext): Boolean;
begin
  Result := inherited;

  // simulate hard work
  Sleep(Random(3000));

  AContext.Connection.IOHandler.WriteLn('Completed at ' + TimeToStr(Now));
end;

{ TMyPushClientThread }

constructor TMyPushClientThread.Create(AHost: string; APort: Word; ALog: TStrings; AFreeLog: Boolean);
begin
  inherited Create(True);

  FLog := ALog;
  FFreeLog := AFreeLog;

  TCPClient := TIdTCPClient.Create;
  TCPClient.Host := AHost;
  TCPClient.Port := APort;
  TCPClient.ReadTimeout := 500;
end;

destructor TMyPushClientThread.Destroy;
begin
  TCPClient.Free;
  if FFreeLog then FLog.Free;
  inherited;
end;

procedure TMyPushClientThread.Execute;
var
  S: string;
begin
  while not Terminated do
  begin
    try
      TCPClient.Connect;
      try
        TCPClient.IOHandler.DefStringEncoding := TIdTextEncoding.UTF8;
        while not Terminated do
        begin
          S := TCPClient.IOHandler.ReadLn;
          if not TCPClient.IOHandler.ReadLnTimedout then
          begin
            TThread.Queue(nil,
              procedure
              begin
                FLog.Append(S);
              end
            );
          end;    
        end;
      finally
        TCPClient.Disconnect;
      end;
    except
      on E: EIdException do begin end;
    end;
    if not Terminated then
      Sleep(1000);
  end;
end;

end.

TCP IP客户端服务器应用程序如何使其工作并使其成为多线程

1 个答案: