135 lines
3.8 KiB
ObjectPascal
135 lines
3.8 KiB
ObjectPascal
unit tcpserver;
|
|
|
|
{$mode ObjFPC}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, tcpthreadhelper, extTypes;
|
|
type
|
|
{ TServerThread }
|
|
|
|
TServerThread=class(TConnectionThread)
|
|
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;
|
|
|
|
{ TServerMainThread }
|
|
TCommandReceived=function(Sender: TMainThread;
|
|
const CommandID:DWORD; const Param:QWord; const ACommand: string; const Fields: TStrings; const iParams: TParamArray; const Data: TStream;
|
|
out Code: DWORD; out RetValue: QWord; out Answer: string; out rValues: TStrings; out iValues: TParamArray; out ByteData: TStream ): boolean of object;
|
|
|
|
TServerMainThread=class(TMainThread)
|
|
private
|
|
fOnReceive: TCommandReceived;
|
|
fOnIdle: TNotifyEvent;
|
|
function processReceive(const CommandID:DWORD; const Param:QWord; const ACommand: string; const Fields: TStrings; const iParams: TParamArray; const Data: TStream;
|
|
out Code: DWORD; out RetValue: QWord; out Answer: string; out rValues: TStrings; out iValues: TParamArray; out ByteData: TStream): boolean;
|
|
public
|
|
property OnIdle: TNotifyEvent read fOnIdle write fOnIdle;
|
|
procedure execute; override;
|
|
constructor Create( ALogger: TLogger; APort: integer; OnReceive:TCommandReceived);
|
|
end;
|
|
|
|
implementation
|
|
{ TServerMainThread }
|
|
|
|
function TServerMainThread.processReceive(const CommandID: DWORD;
|
|
const Param: QWord; const ACommand: string; const Fields: TStrings;
|
|
const iParams: TParamArray; const Data: TStream; out Code: DWORD; out
|
|
RetValue: QWord; out Answer: string; out rValues: TStrings; out
|
|
iValues: TParamArray; out ByteData: TStream): boolean;
|
|
begin
|
|
log(self,'ProcessReceive '+ACommand);
|
|
if assigned(fOnReceive) then
|
|
result := fOnReceive(self,CommandID,Param,ACommand,Fields,IParams,Data,Code,RetValue,Answer,rValues,iValues,ByteData)
|
|
else
|
|
begin
|
|
log(self,'Processor not assigned');
|
|
result := false;
|
|
Code := ErrorProcessor;
|
|
RetValue := 0;
|
|
Answer := 'Server error';
|
|
rValues := nil;
|
|
setLength(iValues,0);
|
|
ByteData := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TServerMainThread.execute;
|
|
var
|
|
n: integer;
|
|
begin
|
|
log(self,'start main thread');
|
|
Connect.Listen(Port);
|
|
n := 0;
|
|
while not terminated do
|
|
begin
|
|
try
|
|
Connect.CallAction;
|
|
|
|
except on e: Exception do
|
|
log(e, '!!ERROR '+e.message);
|
|
end;
|
|
sleep(10);
|
|
inc(n);
|
|
if n>100 then
|
|
begin
|
|
if Assigned(fOnIdle) then fOnIdle(self);
|
|
n :=0;
|
|
end;
|
|
inc(n);
|
|
end;
|
|
end;
|
|
|
|
constructor TServerMainThread.Create(ALogger: TLogger; APort: integer;
|
|
OnReceive: TCommandReceived);
|
|
begin
|
|
inherited Create(TServerThread,ALogger,APort);
|
|
fOnReceive := OnReceive;
|
|
Connect.OnAccept:=@Accept;
|
|
//FreeOnTerminate:=true;
|
|
end;
|
|
{ TServerThread }
|
|
|
|
class function TServerThread.Role: string;
|
|
begin
|
|
result := 'SERVER';
|
|
end;
|
|
|
|
procedure TServerThread.ProcessMessage(const mode: byte; const Code: DWORD;
|
|
const Param: QWord; const ACommand: string; const Values: TStrings;
|
|
const intData: TParamArray; const Data: TStream);
|
|
var
|
|
s: string;
|
|
Vals: TStrings;
|
|
B: TStream;
|
|
res: DWORD;
|
|
rVal: QWord;
|
|
iVals: TParamArray;
|
|
ok: boolean;
|
|
begin
|
|
log(format('ProcessMessage(%d) Param=%x, Command %s ',[code,Param,ACommand]));
|
|
try
|
|
ok := (Owner as TServerMainThread).ProcessReceive(Code,Param,ACommand,Values,IntData,Data,res,rVal,s,Vals,iVals,B);
|
|
try
|
|
if OK then
|
|
SendMessage(cmdAnswer,res,rVal, s,Vals,iVals,B)
|
|
else
|
|
SendMessage(cmdError,res,rVal,s,Vals);
|
|
finally
|
|
if Assigned(Vals) then Vals.Free;
|
|
if Assigned(B) then B.Free;
|
|
end;
|
|
|
|
except on e:Exception do
|
|
begin
|
|
log('!!ERROR ProcessMessage '+e.message);
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end.
|
|
|