LMS-2_ReportAPI/tcpclient.pas
2023-10-19 15:14:52 +03:00

134 lines
3.7 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
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:=true;
fOnComplete:=onReceive;
Connect.OnConnect:=@doConnect;
fCommand := ACommand;
fFields := TStringList.Create;
if assigned(AFields) then
fFields.assign(AFields);
fHost := AHost;
end;
destructor TClientMainThread.Destroy;
begin
log(mtExtra, self,'destroy');
Connect.Disconnect();
fFields.Free;
inherited Destroy;
end;
procedure TClientMainThread.execute;
begin
doStart;
log(mtExtra, self,'start main thread');
Connect.Connect(Host,Port);
while not terminated do
begin
Connect.CallAction;
sleep(10);
end;
Connect.Disconnect();
log(mtExtra, self,'terminated');
end;
procedure TClientMainThread.ProcessConnect(thread: TConnectionThread);
begin
thread.SendMessage(cmdRequest,0,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
try
if assigned(fOnComplete) then
begin
fResult := TCommandData.Create(code,qValue,answer,Values,iValues,Data);
fMode := mode;
Synchronize(@SynchAnswer);
end;
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(mtDebug,format('ProcessMessage(%d) Param=%x, Answer=%s ',[code,Param,ACommand]));
terminate;
Owner.Terminate;
(Owner as TClientMainThread).ProcessAnswer(mode,code,Param,ACommand,Values,intData,Data);
end;
end.