145 lines
4.1 KiB
ObjectPascal
145 lines
4.1 KiB
ObjectPascal
unit tcpClient;
|
|
|
|
{$mode ObjFPC}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, tcpthreadhelper, extTypes;
|
|
type
|
|
{ TClientMainThread }
|
|
TRequestComplete=function(Sender: TMainThread; const mode: byte;
|
|
const Code:DWORD; const QValue: QWORD; const Answer: string; const Values: TStrings; const iValues: TParamArray; const Data: TStream): boolean of object;
|
|
TClientMainThread=class(TMainThread)
|
|
private
|
|
fHost: string;
|
|
fData: TStream;
|
|
fFields: TStrings;
|
|
fCommand: string;
|
|
fOnComplete: TRequestComplete;
|
|
fResult :TCommandData;
|
|
fmode: byte;
|
|
fCode:DWORD;
|
|
fValue:QWORD;
|
|
fAnswer: string;
|
|
fValues: TStrings;
|
|
fResData: TStream;
|
|
fResArray: TParamArray;
|
|
procedure SynchAnswer;
|
|
public
|
|
property Host: string read fHost;
|
|
property Command: string read fCommand write fCommand;
|
|
constructor Create(ACommand: string; AFields: TStrings; ALogger: TLogger;AHost: string; APort: integer; OnReceive:TRequestComplete);
|
|
destructor Destroy; override;
|
|
procedure execute; override;
|
|
procedure ProcessConnect(thread: TConnectionThread); override;
|
|
procedure ProcessAnswer(const mode: byte; const Code:DWORD; const QValue: QWORD; const Answer: string; const Values: TStrings; const iValues: TParamArray; const Data: TStream);
|
|
end;
|
|
|
|
{ TClientThread }
|
|
|
|
TClientThread=class(TConnectionThread)
|
|
public
|
|
class function Role: string; override;
|
|
procedure ProcessMessage(const mode: byte; const Code:DWORD; const Param:QWord; const ACommand: string;const Values: TStrings; const intData: TParamArray; const Data: TStream); override;
|
|
end;
|
|
|
|
implementation
|
|
procedure TClientMainThread.SynchAnswer;
|
|
begin
|
|
log(mtExtra,self,'SynchAnswer');
|
|
if assigned(fOnComplete) then
|
|
fOnComplete(self,fmode,fResult.code,fResult.Param,fResult.Name,fResult.Keys,fResult.iValues,fResult.Data);
|
|
end;
|
|
|
|
constructor TClientMainThread.Create(ACommand: string; AFields: TStrings;
|
|
ALogger: TLogger; AHost: string; APort: integer; OnReceive: TRequestComplete);
|
|
begin
|
|
inherited Create(TClientThread,ALogger,APort);
|
|
FreeOnTerminate:=false;
|
|
fOnComplete:=onReceive;
|
|
Connect.OnConnect:=@doConnect;
|
|
fCommand := ACommand;
|
|
fFields := TStringList.Create;
|
|
if assigned(AFields) then
|
|
fFields.assign(AFields);
|
|
fHost := AHost;
|
|
fResult := nil;
|
|
end;
|
|
|
|
destructor TClientMainThread.Destroy;
|
|
begin
|
|
log(mtExtra, self,'destroy');
|
|
Connect.Disconnect();
|
|
fFields.Free;
|
|
if assigned(fResult) then
|
|
FreeAndNil(fResult);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
|
|
procedure TClientMainThread.execute;
|
|
begin
|
|
doStart;
|
|
log(mtExtra, self,format('start main thread %s:%d',[Host,Port]));
|
|
Connect.Connect(Host,Port);
|
|
try
|
|
while not terminated and not Complete do
|
|
begin
|
|
Connect.CallAction;
|
|
sleep(10);
|
|
end;
|
|
|
|
finally
|
|
log(mtExtra,self,'main thread terminated');
|
|
end;
|
|
TerminateClients;
|
|
Connect.Disconnect();
|
|
log(mtExtra, self,'terminated');
|
|
end;
|
|
|
|
procedure TClientMainThread.ProcessConnect(thread: TConnectionThread);
|
|
begin
|
|
log(mtDebug,self,'ProcessConnect '+GuidToString(thread.ID));
|
|
thread.SendMessage(cmdRequest,1,0,self.Command,self.fFields);
|
|
end;
|
|
|
|
procedure TClientMainThread.ProcessAnswer(const mode: byte; const Code: DWORD;
|
|
const QValue: QWORD; const Answer: string; const Values: TStrings;
|
|
const iValues: TParamArray; const Data: TStream);
|
|
begin
|
|
log(mtExtra,self,'ProcessAnswer '+Answer);
|
|
try
|
|
if assigned(fOnComplete) then
|
|
begin
|
|
fResult := TCommandData.Create(code,qValue,answer,Values,iValues,Data);
|
|
fMode := mode;
|
|
Synchronize(@SynchAnswer);
|
|
|
|
|
|
end;
|
|
SetComplete;
|
|
except on e:Exception do
|
|
begin
|
|
log(mtError, self,'!!ERROR ProcessAnswer '+e.message);
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
class function TClientThread.Role: string;
|
|
begin
|
|
result := 'CLIENT';
|
|
end;
|
|
|
|
procedure TClientThread.ProcessMessage(const mode: byte; const Code: DWORD;
|
|
const Param: QWord; const ACommand: string; const Values: TStrings;
|
|
const intData: TParamArray; const Data: TStream);
|
|
begin
|
|
log(mtExtra,format('ProcessMessage(%d) Param=%x, Answer=%s ',[code,Param,ACommand]));
|
|
(Owner as TClientMainThread).ProcessAnswer(mode,code,Param,ACommand,Values,intData,Data);
|
|
end;
|
|
|
|
end.
|
|
|