您好,我有来自此链接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;
我有这个错误:
请帮助我希望服务器接受来自客户端的连接并将消息接收到备忘录。
答案 0 :(得分:3)
尝试更像这样的事情:
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.