LMS2.1
This commit is contained in:
parent
0d383309ce
commit
3ad8894107
@ -18,7 +18,7 @@ type
|
|||||||
fConnectionID: string;
|
fConnectionID: string;
|
||||||
fTimeout: integer;
|
fTimeout: integer;
|
||||||
fProcessor: TNIDBDM;
|
fProcessor: TNIDBDM;
|
||||||
|
fJournal: TStrings;
|
||||||
Commands: TStrings;
|
Commands: TStrings;
|
||||||
DoneCommands: TList;
|
DoneCommands: TList;
|
||||||
fCreated,
|
fCreated,
|
||||||
@ -51,7 +51,7 @@ type
|
|||||||
property ConnectionID: string read fConnectionID;
|
property ConnectionID: string read fConnectionID;
|
||||||
property Processor: TNIDBDM read fProcessor;
|
property Processor: TNIDBDM read fProcessor;
|
||||||
procedure Init;
|
procedure Init;
|
||||||
constructor Create(AOwner: TComponent;ATimeOut: integer; aLogger: TLogger);
|
constructor Create(AOwner: TComponent;ATimeOut: integer; aLogger: TLogger; ID: string='');
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
// CommandID,Param,ACommand,Fields,iParam.Data
|
// CommandID,Param,ACommand,Fields,iParam.Data
|
||||||
function AddCommand(ACode: DWORD; iParam: QWORD; ACommandClass,ACommandName: string; Arguments: TStrings; intArgs: TParamArray; CmdData: TStream; out ID: string; out retCode:DWORD; out Errors: TStrings): boolean;
|
function AddCommand(ACode: DWORD; iParam: QWORD; ACommandClass,ACommandName: string; Arguments: TStrings; intArgs: TParamArray; CmdData: TStream; out ID: string; out retCode:DWORD; out Errors: TStrings): boolean;
|
||||||
@ -63,6 +63,7 @@ type
|
|||||||
function ProcessOptionValues(ReportName,ParamName: string; ParamValues: TStrings; out Answer: string; out RetValue: QWORD; out OptionValues: TStrings): boolean;
|
function ProcessOptionValues(ReportName,ParamName: string; ParamValues: TStrings; out Answer: string; out RetValue: QWORD; out OptionValues: TStrings): boolean;
|
||||||
class function newID: string;
|
class function newID: string;
|
||||||
function calchash(data: TStream): string;
|
function calchash(data: TStream): string;
|
||||||
|
property Journal: TStrings read fJournal;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
@ -84,10 +85,13 @@ end;
|
|||||||
|
|
||||||
|
|
||||||
constructor TBaseConnection.Create(AOwner: TComponent; ATimeOut: integer;
|
constructor TBaseConnection.Create(AOwner: TComponent; ATimeOut: integer;
|
||||||
aLogger: TLogger);
|
aLogger: TLogger; ID: string);
|
||||||
begin
|
begin
|
||||||
inherited Create(true);
|
inherited Create(true);
|
||||||
fConnectionID:=newID;
|
if ID='' then
|
||||||
|
fConnectionID:=newID
|
||||||
|
else
|
||||||
|
fConnectionID:=ID;
|
||||||
fTimeout:=ATimeOut;
|
fTimeout:=ATimeOut;
|
||||||
fOwner := AOwner;
|
fOwner := AOwner;
|
||||||
flogger := ALogger;
|
flogger := ALogger;
|
||||||
@ -103,7 +107,7 @@ begin
|
|||||||
nCommandReceived:=0;
|
nCommandReceived:=0;
|
||||||
nCommandReady:=0;
|
nCommandReady:=0;
|
||||||
nErrors:=0;
|
nErrors:=0;
|
||||||
|
fJournal := TStringList.Create;
|
||||||
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -113,6 +117,7 @@ begin
|
|||||||
Processor.Free;
|
Processor.Free;
|
||||||
Commands.Free;
|
Commands.Free;
|
||||||
DoneCommands.Free;
|
DoneCommands.Free;
|
||||||
|
fJournal.free;
|
||||||
inherited;
|
inherited;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -132,7 +137,7 @@ begin
|
|||||||
cc := TCommandCollection.Find(ACommandClass,ACommandName);
|
cc := TCommandCollection.Find(ACommandClass,ACommandName);
|
||||||
if assigned(cc) then
|
if assigned(cc) then
|
||||||
begin
|
begin
|
||||||
cmd := cc.Create(self.newID, self.Processor,ACommandName,fLogger,User,UserID);
|
cmd := cc.Create(self.newID, self.Processor,ACommandName,@log,User,UserID);
|
||||||
cmd.AccessTime:=NOW();
|
cmd.AccessTime:=NOW();
|
||||||
try
|
try
|
||||||
result := cmd.ParseCommand(ACode,iParam,ACommandName,Arguments,intArgs,CmdData, Errors);
|
result := cmd.ParseCommand(ACode,iParam,ACommandName,Arguments,intArgs,CmdData, Errors);
|
||||||
@ -145,14 +150,18 @@ begin
|
|||||||
end;
|
end;
|
||||||
if result then
|
if result then
|
||||||
begin
|
begin
|
||||||
|
|
||||||
Commands.AddObject(ACommandName,cmd);
|
Commands.AddObject(ACommandName,cmd);
|
||||||
ID := cmd.CommandID;
|
ID := cmd.CommandID;
|
||||||
retCode := Commands.Count;
|
retCode := Commands.Count;
|
||||||
|
log(mtInfo,cmd, format('%s(%s) %s поставлена в очередь %d',[cmd.CommandName, cmd.CommandSubClass, cmd.CommandID,Commands.Count]));
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
ID := 'неверные параметры запроса';
|
ID := 'неверные параметры запроса';
|
||||||
retCode := ErrorArguments;
|
retCode := ErrorArguments;
|
||||||
|
log(mtError,cmd, format('%s(%s) %s неверные параметры запроса %s',[cmd.CommandName, cmd.CommandSubClass, cmd.CommandID, Errors.CommaText]));
|
||||||
|
|
||||||
inc(nErrors);
|
inc(nErrors);
|
||||||
cmd.Error:=true;
|
cmd.Error:=true;
|
||||||
cmd.Done;
|
cmd.Done;
|
||||||
@ -217,7 +226,7 @@ begin
|
|||||||
fCheckConnect:=false;
|
fCheckConnect:=false;
|
||||||
d := Created;
|
d := Created;
|
||||||
if LastAccess>d then d := LastAccess;
|
if LastAccess>d then d := LastAccess;
|
||||||
if (now()-d)*24*60>fTimeout then
|
if (ConnectionID<>'0') and ((now()-d)*24*60>fTimeout) then
|
||||||
begin
|
begin
|
||||||
log(mtInfo,self,'TIMEOUT');
|
log(mtInfo,self,'TIMEOUT');
|
||||||
terminate;
|
terminate;
|
||||||
@ -251,6 +260,11 @@ end;
|
|||||||
|
|
||||||
procedure TBaseConnection.Log(ALevel: TLogLevel; sender: TObject; msg: string);
|
procedure TBaseConnection.Log(ALevel: TLogLevel; sender: TObject; msg: string);
|
||||||
begin
|
begin
|
||||||
|
case ALevel of
|
||||||
|
mtError: fJournal.AddObject('ERROR:'#09+msg, TObject(PtrInt(trunc(now()*24*60*60*10))));
|
||||||
|
mtWarning: fJournal.AddObject('WARNING:'#09+msg, TObject(PtrInt(trunc(now()*24*60*60*10))));
|
||||||
|
mtInfo: fJournal.AddObject('INFO:'#09+msg, TObject(PtrInt(trunc(now()*24*60*60*10))));
|
||||||
|
end;
|
||||||
if assigned(fLogger) then
|
if assigned(fLogger) then
|
||||||
flogger(ALevel,sender,msg);
|
flogger(ALevel,sender,msg);
|
||||||
end;
|
end;
|
||||||
|
@ -17,7 +17,7 @@ type
|
|||||||
procedure Execute;override;
|
procedure Execute;override;
|
||||||
function sleepMin(n: integer): boolean;
|
function sleepMin(n: integer): boolean;
|
||||||
constructor Create(AOwner: TLMSReportCGI);
|
constructor Create(AOwner: TLMSReportCGI);
|
||||||
|
function CheckTerminated(Sender: TObject): boolean;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TLMSReportCGI }
|
{ TLMSReportCGI }
|
||||||
@ -60,6 +60,12 @@ begin
|
|||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
self.logger.Identification:='LMS-Report-Service';
|
self.logger.Identification:='LMS-Report-Service';
|
||||||
self.Logger.Active:=true;
|
self.Logger.Active:=true;
|
||||||
|
if Definition<>nil then
|
||||||
|
try
|
||||||
|
self.logger.Info(format('Daemon(%d) %s/%s {%s} (%s)',[Definition.ID, Definition.Name,Definition.DisplayName,Definition.Description,Definition.RunArguments]));
|
||||||
|
except on e: Exception do
|
||||||
|
self.logger.Error('DataModuleCreate '+e.Message);
|
||||||
|
end;
|
||||||
workThread := TDaemonThread.create(self);
|
workThread := TDaemonThread.create(self);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -88,7 +94,9 @@ procedure TDaemonThread.Execute;
|
|||||||
begin
|
begin
|
||||||
fData := TConnectionsDM.CreateWithLog(fLogger);
|
fData := TConnectionsDM.CreateWithLog(fLogger);
|
||||||
try
|
try
|
||||||
fData.Start;
|
flogger.Debug('TDaemonThread.Execute.1');
|
||||||
|
fData.Start(@CheckTerminated);
|
||||||
|
flogger.Debug('TDaemonThread.Execute.Started');
|
||||||
while not terminated do
|
while not terminated do
|
||||||
begin
|
begin
|
||||||
if sleepMin(5) then
|
if sleepMin(5) then
|
||||||
@ -119,6 +127,11 @@ begin
|
|||||||
fLogger:=AOwner.Logger;
|
fLogger:=AOwner.Logger;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TDaemonThread.CheckTerminated(Sender: TObject): boolean;
|
||||||
|
begin
|
||||||
|
result := terminated;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
initialization
|
initialization
|
||||||
RegisterDaemon;
|
RegisterDaemon;
|
||||||
|
@ -13,8 +13,10 @@ object DaemonMapper1: TDaemonMapper1
|
|||||||
WinBindings.ServiceType = stWin32
|
WinBindings.ServiceType = stWin32
|
||||||
WinBindings.ErrorSeverity = esIgnore
|
WinBindings.ErrorSeverity = esIgnore
|
||||||
WinBindings.AcceptedCodes = []
|
WinBindings.AcceptedCodes = []
|
||||||
|
OnCreateInstance = DaemonMapper1DaemonDefs0CreateInstance
|
||||||
LogStatusReport = False
|
LogStatusReport = False
|
||||||
end>
|
end>
|
||||||
|
OnCreate = DaemonMapper1Create
|
||||||
Left = 1065
|
Left = 1065
|
||||||
Top = 332
|
Top = 332
|
||||||
end
|
end
|
||||||
|
@ -8,7 +8,12 @@ uses
|
|||||||
Classes, SysUtils, DaemonApp;
|
Classes, SysUtils, DaemonApp;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|
||||||
|
{ TDaemonMapper1 }
|
||||||
|
|
||||||
TDaemonMapper1 = class(TDaemonMapper)
|
TDaemonMapper1 = class(TDaemonMapper)
|
||||||
|
procedure DaemonMapper1Create(Sender: TObject);
|
||||||
|
procedure DaemonMapper1DaemonDefs0CreateInstance(Sender: TObject);
|
||||||
private
|
private
|
||||||
|
|
||||||
public
|
public
|
||||||
@ -19,7 +24,8 @@ var
|
|||||||
DaemonMapper1: TDaemonMapper1;
|
DaemonMapper1: TDaemonMapper1;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
uses
|
||||||
|
lazutf8;
|
||||||
procedure RegisterMapper;
|
procedure RegisterMapper;
|
||||||
begin
|
begin
|
||||||
RegisterDaemonMapper(TDaemonMapper1)
|
RegisterDaemonMapper(TDaemonMapper1)
|
||||||
@ -27,6 +33,25 @@ end;
|
|||||||
|
|
||||||
{$R *.lfm}
|
{$R *.lfm}
|
||||||
|
|
||||||
|
{ TDaemonMapper1 }
|
||||||
|
|
||||||
|
procedure TDaemonMapper1.DaemonMapper1Create(Sender: TObject);
|
||||||
|
var
|
||||||
|
i: integer;
|
||||||
|
begin
|
||||||
|
for i := 0 to DaemonDefs.Count-1 do
|
||||||
|
begin
|
||||||
|
DaemonDefs.Daemons[i].DisplayName:=UTF8ToConsole(DaemonDefs.Daemons[i].DisplayName);
|
||||||
|
DaemonDefs.Daemons[i].Description:=UTF8ToConsole(DaemonDefs.Daemons[i].Description);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDaemonMapper1.DaemonMapper1DaemonDefs0CreateInstance(Sender: TObject
|
||||||
|
);
|
||||||
|
begin
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
initialization
|
initialization
|
||||||
RegisterMapper;
|
RegisterMapper;
|
||||||
|
19
cgidm.pas
19
cgidm.pas
@ -43,6 +43,7 @@ type
|
|||||||
function CheckConnection: boolean;
|
function CheckConnection: boolean;
|
||||||
function QueryValue(ASQL: string; Default: string=''): string;
|
function QueryValue(ASQL: string; Default: string=''): string;
|
||||||
function QueryIntValue(ASQL: string): integer;
|
function QueryIntValue(ASQL: string): integer;
|
||||||
|
function QueryDateValue(ASQL: string): TDateTime;
|
||||||
function GetData(ASQL: string): TDataSet;
|
function GetData(ASQL: string): TDataSet;
|
||||||
function CheckUser(const login,password: string; out UserID: integer): boolean;
|
function CheckUser(const login,password: string; out UserID: integer): boolean;
|
||||||
procedure OpenConnection;
|
procedure OpenConnection;
|
||||||
@ -330,6 +331,22 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TNIDBDM.QueryDateValue(ASQL: string): TDateTime;
|
||||||
|
begin
|
||||||
|
log(mtDebug,self,'QueryIntValue'#13#10+ASQL);
|
||||||
|
CheckConnection;
|
||||||
|
with TnnzQuery.Create(self) do
|
||||||
|
try
|
||||||
|
Connection := fcon;
|
||||||
|
SQL.Text:=ASQL;
|
||||||
|
Open;
|
||||||
|
if not eof then result := Fields[0].AsDateTime else result := 0;
|
||||||
|
finally
|
||||||
|
free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
function TNIDBDM.GetData(ASQL: string): TDataSet;
|
function TNIDBDM.GetData(ASQL: string): TDataSet;
|
||||||
begin
|
begin
|
||||||
@ -355,7 +372,7 @@ end;
|
|||||||
|
|
||||||
procedure TNIDBDM.OpenConnection;
|
procedure TNIDBDM.OpenConnection;
|
||||||
begin
|
begin
|
||||||
log(mtDebug,self,'OpenConnection');
|
log(mtDebug,self,format('OpenConnection %s:%d',[connection.RemoteHost,connection.RemotePort]));
|
||||||
fcon.Connected:=true;
|
fcon.Connected:=true;
|
||||||
fcon.Identify;
|
fcon.Identify;
|
||||||
end;
|
end;
|
||||||
|
@ -85,11 +85,11 @@ var
|
|||||||
d: TStringDynArray;
|
d: TStringDynArray;
|
||||||
i: integer;
|
i: integer;
|
||||||
begin
|
begin
|
||||||
ReportCode := Processor.QueryValue(format('select report_routine from xp_report_cgi where cgi_name=%s',[TNidbDM.StringAsSQL(ReportName)]));
|
ReportCode := Processor.QueryValue(format('select report_routine from xp_report_cgi where cgi_name=%s',[TNIDBDM.StringAsSQL(ReportName)]));
|
||||||
UpdateCodeWithArguments(ReportCode);
|
UpdateCodeWithArguments(ReportCode);
|
||||||
if reportcode<>'' then
|
if reportcode<>'' then
|
||||||
Processor.ExecuteSQL(format('select %s;',[ReportCode]));
|
Processor.ExecuteSQL(format('select %s;',[ReportCode]));
|
||||||
ASQL := format( 'select array_to_string(extra_routines,'';'') as v from xp_report_cgi where cgi_name=%s',[TNidbDM.StringAsSQL(ReportName)]);
|
ASQL := format( 'select array_to_string(extra_routines,'';'') as v from xp_report_cgi where cgi_name=%s',[TNIDBDM.StringAsSQL(ReportName)]);
|
||||||
v := Processor.QueryValue(ASQL);
|
v := Processor.QueryValue(ASQL);
|
||||||
if v>'' then
|
if v>'' then
|
||||||
begin
|
begin
|
||||||
@ -106,7 +106,7 @@ end;
|
|||||||
|
|
||||||
procedure TReportCommand.PrepareVars;
|
procedure TReportCommand.PrepareVars;
|
||||||
begin
|
begin
|
||||||
VarCode := Processor.QueryValue(format('select report_routine_vars from xp_report_cgi where cgi_name=%s',[TNidbDM.StringAsSQL(ReportName)]));
|
VarCode := Processor.QueryValue(format('select report_routine_vars from xp_report_cgi where cgi_name=%s',[TNIDBDM.StringAsSQL(ReportName)]));
|
||||||
UpdateCodeWithArguments(VarCode);
|
UpdateCodeWithArguments(VarCode);
|
||||||
if VarCode<>'' then
|
if VarCode<>'' then
|
||||||
Processor.ExecuteSQL(format('select %s;',[VarCode]));
|
Processor.ExecuteSQL(format('select %s;',[VarCode]));
|
||||||
@ -144,7 +144,7 @@ begin
|
|||||||
vs := '';
|
vs := '';
|
||||||
end;
|
end;
|
||||||
script := script + format(#13#10'insert into tmp_report_variables(name,value_string,var_type) values (%s,%s,0); ',
|
script := script + format(#13#10'insert into tmp_report_variables(name,value_string,var_type) values (%s,%s,0); ',
|
||||||
[TNIDBDM.StringAsSQL(fieldByName('name').asString),TNidbDM.StringAsSQL(vs)]);
|
[TNIDBDM.StringAsSQL(fieldByName('name').asString),TNIDBDM.StringAsSQL(vs)]);
|
||||||
Next;
|
Next;
|
||||||
end;
|
end;
|
||||||
finally
|
finally
|
||||||
@ -212,13 +212,13 @@ begin
|
|||||||
fcurrentStage := 'исполняется (инициализация)';
|
fcurrentStage := 'исполняется (инициализация)';
|
||||||
fileData := TMemoryStream.Create;
|
fileData := TMemoryStream.Create;
|
||||||
try
|
try
|
||||||
ReportID := Processor.QueryIntValue(format('select xp_rpt_id from xp_report_cgi where cgi_name=%s',[TNidbDM.StringAsSQL(ReportName)]));
|
ReportID := Processor.QueryIntValue(format('select xp_rpt_id from xp_report_cgi where cgi_name=%s',[TNIDBDM.StringAsSQL(ReportName)]));
|
||||||
if ReportID<=0 then
|
if ReportID<=0 then
|
||||||
begin
|
begin
|
||||||
fResult := TCommandData.Create(ErrorArguments,0,'Отчет не найден',nil,[],nil);
|
fResult := TCommandData.Create(ErrorArguments,0,'Отчет не найден',nil,[],nil);
|
||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
ReportTitle := Processor.QueryValue(format('select r.name from xp_report_cgi g join xp_report r on r.xp_rpt_id=g.xp_rpt_id where cgi_name=%s',[TNidbDM.StringAsSQL(ReportName)]));
|
ReportTitle := Processor.QueryValue(format('select r.name from xp_report_cgi g join xp_report r on r.xp_rpt_id=g.xp_rpt_id where cgi_name=%s',[TNIDBDM.StringAsSQL(ReportName)]));
|
||||||
CreateVariablesTable;
|
CreateVariablesTable;
|
||||||
log(mtInfo,'Построение отчета '+ReportTitle);
|
log(mtInfo,'Построение отчета '+ReportTitle);
|
||||||
ReportProcessor.RecordID:=ReportID;
|
ReportProcessor.RecordID:=ReportID;
|
||||||
@ -253,7 +253,7 @@ begin
|
|||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
fResult := TCommandData.Create(0,fileData.size,ReportTitle+'.pdf',['type=application/pdf'],[],fileData);
|
fResult := TCommandData.Create(0,fileData.size,ReportTitle+'.pdf',['{"type":"application/pdf"}'],[],fileData);
|
||||||
fileData.Seek(0,soFromBeginning);
|
fileData.Seek(0,soFromBeginning);
|
||||||
{$IFDEF DEBUG} (fileData as TMemoryStream).SaveToFile(format('%sout/%s_%s.pdf',[ Extractfilepath(paramstr(0)),self.CommandID,ReportTitle])); {$ENDIF}
|
{$IFDEF DEBUG} (fileData as TMemoryStream).SaveToFile(format('%sout/%s_%s.pdf',[ Extractfilepath(paramstr(0)),self.CommandID,ReportTitle])); {$ENDIF}
|
||||||
fileData.Seek(0,soFromBeginning);
|
fileData.Seek(0,soFromBeginning);
|
||||||
@ -269,6 +269,19 @@ var
|
|||||||
asql: string;
|
asql: string;
|
||||||
ids: string;
|
ids: string;
|
||||||
i: integer;
|
i: integer;
|
||||||
|
value: string;
|
||||||
|
val_int: integer;
|
||||||
|
val_float: double;
|
||||||
|
val_date: TDateTime;
|
||||||
|
fmt: TFormatSettings;
|
||||||
|
val_ids: TStringDynArray;
|
||||||
|
procedure AddToErrors(error: string);
|
||||||
|
begin
|
||||||
|
if not assigned(Errors) then
|
||||||
|
Errors := TStringList.Create;
|
||||||
|
Errors.Add(error);
|
||||||
|
end;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
result := false;
|
result := false;
|
||||||
Errors := nil;
|
Errors := nil;
|
||||||
@ -302,7 +315,45 @@ begin
|
|||||||
finally
|
finally
|
||||||
free;
|
free;
|
||||||
end;
|
end;
|
||||||
|
asql := format(
|
||||||
|
'select p.name, p.type from xp_report_cgi c '+
|
||||||
|
'join xp_report_params p on p.xp_rpt_id=c.xp_rpt_id and coalesce(p.required,true) '+
|
||||||
|
'where c.cgi_name=%s and p.name in (%s) '+
|
||||||
|
' and p.type in (1,2) '+
|
||||||
|
'order by fill_order,p.name ',
|
||||||
|
[TNIDBDM.StringAsSQL(ReportName),(ids)]);
|
||||||
|
fmt.DateSeparator:='-';
|
||||||
|
fmt.TimeSeparator:=':';
|
||||||
|
fmt.ShortDateFormat:='yyyy-mm-dd';
|
||||||
|
fmt.ShortTimeFormat:='hh:nn:ss';
|
||||||
|
with Processor.GetData(asql) do
|
||||||
|
try
|
||||||
|
while not eof do
|
||||||
|
begin
|
||||||
|
value := Arguments.Keys.Values[fieldbyname('name').AsString];
|
||||||
|
case FieldByName('type').asInteger of
|
||||||
|
1: if not TryStrToInt(value,val_int) then AddToErrors(format('{name:"%s",type:"ID"}',[TNIDBDM.StringAsJSON(FieldByName('name').AsString)]));
|
||||||
|
2: if not TryStrToInt(value,val_int) then AddToErrors(format('{name:"%s",type:"integer"}',[TNIDBDM.StringAsJSON(FieldByName('name').AsString)]));
|
||||||
|
3: if not TryStrToFloat(value,val_float) then AddToErrors(format('{name:"%s",type:"float"}',[TNIDBDM.StringAsJSON(FieldByName('name').AsString)]));
|
||||||
|
4: if not TryStrToDate(value,val_date,'yyyy-mm-dd','-') then AddToErrors(format('{name:"%s",type:"date"}',[TNIDBDM.StringAsJSON(FieldByName('name').AsString)]));
|
||||||
|
5: if not TryStrToDateTime(value,val_date,fmt) then AddToErrors(format('{name:"%s",type:"time"}',[TNIDBDM.StringAsJSON(FieldByName('name').AsString)]));
|
||||||
|
6: if not( (Value='0') or (Value='1') ) then AddToErrors(format('{name:"%s",type:"boolean"}',[TNIDBDM.StringAsJSON(FieldByName('name').AsString)]));
|
||||||
|
17: begin
|
||||||
|
val_ids := SplitString(value,',');
|
||||||
|
for i := low(val_ids) to high(val_ids) do
|
||||||
|
if not TryStrToInt(val_ids[i],val_int) then
|
||||||
|
begin
|
||||||
|
AddToErrors(format('{name:"%s",type:"IDS"}',[TNIDBDM.StringAsJSON(FieldByName('name').AsString)]));
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
next;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
free;
|
||||||
|
end;
|
||||||
|
result := not assigned(Errors);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TReportCommand.ProcessOptionValues(ParamName: string; out
|
function TReportCommand.ProcessOptionValues(ParamName: string; out
|
||||||
|
@ -125,6 +125,8 @@ end;
|
|||||||
constructor TCommand.Create(ID: string; aProcessor: TNIDBDM; ASubClass: string;
|
constructor TCommand.Create(ID: string; aProcessor: TNIDBDM; ASubClass: string;
|
||||||
aLogger: TLogger; AUser: string; IDUser: integer);
|
aLogger: TLogger; AUser: string; IDUser: integer);
|
||||||
begin
|
begin
|
||||||
|
if assigned(aLogger) then
|
||||||
|
aLogger(mtExtra,self,'CREATE '+self.ClassName);
|
||||||
fProcessor := AProcessor;
|
fProcessor := AProcessor;
|
||||||
fSubClass := ASubClass;
|
fSubClass := ASubClass;
|
||||||
fStatus:=StatusWaiting;
|
fStatus:=StatusWaiting;
|
||||||
@ -149,6 +151,7 @@ end;
|
|||||||
|
|
||||||
procedure TCommand.doRun;
|
procedure TCommand.doRun;
|
||||||
begin
|
begin
|
||||||
|
log(mtInfo,format('%s(%s) %s - начато выполнение',[commandName,CommandSubClass, commandID]));
|
||||||
fStatus:=StatusProcessing;
|
fStatus:=StatusProcessing;
|
||||||
fcurrentStage := 'исполняется';
|
fcurrentStage := 'исполняется';
|
||||||
try
|
try
|
||||||
@ -156,11 +159,13 @@ begin
|
|||||||
begin
|
begin
|
||||||
fStatus:=StatusComplete;
|
fStatus:=StatusComplete;
|
||||||
fcurrentStage := 'завершена';
|
fcurrentStage := 'завершена';
|
||||||
|
log(mtInfo,format('%s(%s) %s - выполнена',[commandName,CommandSubClass, commandID]));
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
fStatus := StatusError;
|
fStatus := StatusError;
|
||||||
fcurrentStage := 'завершена c ошибкой';
|
fcurrentStage := 'завершена c ошибкой';
|
||||||
|
log(mtInfo,format('%s(%s) %s - ошибка',[commandName,CommandSubClass, commandID]));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
except on e: Exception do
|
except on e: Exception do
|
||||||
|
@ -4,7 +4,7 @@ object ConnectionsDM: TConnectionsDM
|
|||||||
OldCreateOrder = False
|
OldCreateOrder = False
|
||||||
Height = 150
|
Height = 150
|
||||||
HorizontalOffset = 738
|
HorizontalOffset = 738
|
||||||
VerticalOffset = 342
|
VerticalOffset = 344
|
||||||
Width = 533
|
Width = 533
|
||||||
object Process1: TProcess
|
object Process1: TProcess
|
||||||
Active = False
|
Active = False
|
||||||
|
@ -34,8 +34,9 @@ type
|
|||||||
fLogger: TEventLog;
|
fLogger: TEventLog;
|
||||||
fTimeOut: integer;
|
fTimeOut: integer;
|
||||||
fRunning: boolean;
|
fRunning: boolean;
|
||||||
|
fTermiinateCheck: TChecker;
|
||||||
function getConnection(ID: string): TBaseConnection;
|
function getConnection(ID: string): TBaseConnection;
|
||||||
function NewConnection: TBaseConnection;
|
function NewConnection(ID: string=''): TBaseConnection;
|
||||||
procedure Remove(con: TBaseConnection); overload;
|
procedure Remove(con: TBaseConnection); overload;
|
||||||
procedure Remove(ID: string); overload;
|
procedure Remove(ID: string); overload;
|
||||||
procedure ClearConnections;
|
procedure ClearConnections;
|
||||||
@ -55,7 +56,7 @@ type
|
|||||||
procedure Log(ALevel: TLogLevel; Sender: TObject; msg: string);
|
procedure Log(ALevel: TLogLevel; Sender: TObject; msg: string);
|
||||||
procedure LogError(Sender: TObject; e: Exception; Command: string);
|
procedure LogError(Sender: TObject; e: Exception; Command: string);
|
||||||
procedure InitBaseCon;
|
procedure InitBaseCon;
|
||||||
procedure Start;
|
procedure Start(isTerminated: TChecker);
|
||||||
procedure Stop;
|
procedure Stop;
|
||||||
procedure Idle(Sender: TObject);
|
procedure Idle(Sender: TObject);
|
||||||
property Running: boolean read fRunning;
|
property Running: boolean read fRunning;
|
||||||
@ -65,6 +66,7 @@ type
|
|||||||
constructor CreateWithLog(ALogger: TEventLog);
|
constructor CreateWithLog(ALogger: TEventLog);
|
||||||
procedure FillTemplates(RepList: TStrings);
|
procedure FillTemplates(RepList: TStrings);
|
||||||
procedure EditTemplate(ReportID: integer);
|
procedure EditTemplate(ReportID: integer);
|
||||||
|
procedure TestReport(ReportID: integer);
|
||||||
function CalcHash(Data: TStream): string;
|
function CalcHash(Data: TStream): string;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -82,12 +84,20 @@ uses
|
|||||||
{ TConnectionsDM }
|
{ TConnectionsDM }
|
||||||
|
|
||||||
procedure TConnectionsDM.DataModuleCreate(Sender: TObject);
|
procedure TConnectionsDM.DataModuleCreate(Sender: TObject);
|
||||||
|
var
|
||||||
|
con: TBaseConnection;
|
||||||
begin
|
begin
|
||||||
fRunning := false;
|
fRunning := false;
|
||||||
conList := TList.Create;
|
conList := TList.Create;
|
||||||
MainCon := TNIDBDM.CreateWithLogger(@log);
|
MainCon := TNIDBDM.CreateWithLogger(@log);
|
||||||
LoadConfig;
|
LoadConfig;
|
||||||
input := TServerMainThread.Create(@log,fServicePort,@ProcessRequest);
|
input := nil;
|
||||||
|
{$IFDEF DEBUG}
|
||||||
|
con := NewConnection('0');
|
||||||
|
con.User:='anonymous';
|
||||||
|
con.UserID := 0;
|
||||||
|
con.Start;
|
||||||
|
{$ENDIF}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TConnectionsDM.DataModuleDestroy(Sender: TObject);
|
procedure TConnectionsDM.DataModuleDestroy(Sender: TObject);
|
||||||
@ -99,8 +109,10 @@ begin
|
|||||||
begin
|
begin
|
||||||
Input.Terminate;
|
Input.Terminate;
|
||||||
Input.WaitFor;
|
Input.WaitFor;
|
||||||
|
Input.Free;
|
||||||
end;
|
end;
|
||||||
Input.Free;
|
|
||||||
|
|
||||||
MainCon.Free;
|
MainCon.Free;
|
||||||
conList.Free;
|
conList.Free;
|
||||||
|
|
||||||
@ -120,13 +132,13 @@ begin
|
|||||||
result := nil;
|
result := nil;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TConnectionsDM.NewConnection: TBaseConnection;
|
function TConnectionsDM.NewConnection(ID: string): TBaseConnection;
|
||||||
var
|
var
|
||||||
g: TGUID;
|
g: TGUID;
|
||||||
s: string;
|
s: string;
|
||||||
i: integer;
|
i: integer;
|
||||||
begin
|
begin
|
||||||
result := TBaseConnection.Create(self,fTimeOut,@Log);
|
result := TBaseConnection.Create(self,fTimeOut,@Log,ID);
|
||||||
conlist.add(result);
|
conlist.add(result);
|
||||||
result.Host:=DataHost;
|
result.Host:=DataHost;
|
||||||
result.port:=DataPort;
|
result.port:=DataPort;
|
||||||
@ -209,14 +221,24 @@ function TConnectionsDM.ProcessRequest(Sender: TMainThread;
|
|||||||
const Fields: TStrings; const iParams: TParamArray; const Data: TStream; out
|
const Fields: TStrings; const iParams: TParamArray; const Data: TStream; out
|
||||||
Code: DWORD; out RetValue: QWord; out Answer: string; out rValues: TStrings;
|
Code: DWORD; out RetValue: QWord; out Answer: string; out rValues: TStrings;
|
||||||
out iValues: TParamArray; out ByteData: TStream): boolean;
|
out iValues: TParamArray; out ByteData: TStream): boolean;
|
||||||
|
procedure waitforresult(Pause: integer; acmd: TCommand);
|
||||||
|
begin
|
||||||
|
if acmd.Status in [StatusComplete,StatusError] then exit;
|
||||||
|
while (pause>0) and not(acmd.Status in [StatusWaiting,StatusProcessing]) do
|
||||||
|
begin
|
||||||
|
Sleep(1000);
|
||||||
|
dec(pause);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
var
|
var
|
||||||
UserID: integer;
|
UserID: integer;
|
||||||
con: TBaseConnection;
|
con: TBaseConnection;
|
||||||
userName,conID,cmdID: string;
|
userName,conID,cmdID: string;
|
||||||
cmd: TCommand;
|
cmd: TCommand;
|
||||||
|
i: integer;
|
||||||
begin
|
begin
|
||||||
try
|
try
|
||||||
log(mtDebug, Self,'Обработка запроса '+ACommand);
|
log(mtInfo, Self,'Обработка запроса '+ACommand);
|
||||||
ClearTerminated;
|
ClearTerminated;
|
||||||
result := false;
|
result := false;
|
||||||
RetValue := 0;
|
RetValue := 0;
|
||||||
@ -240,10 +262,11 @@ begin
|
|||||||
rvalues.Add('"help"');
|
rvalues.Add('"help"');
|
||||||
rvalues.Add('"version"');
|
rvalues.Add('"version"');
|
||||||
rValues.add('"reports"');
|
rValues.add('"reports"');
|
||||||
rValues.add('{action:"arguments",params:["name"]}');
|
rValues.add('{action:"arguments",params:["report"]}');
|
||||||
rValues.add('{action:"login",params:["user","password"]}');
|
rValues.add('{action:"login",params:["user","password"]}');
|
||||||
rValues.add('{action:"logout",params:["connect"]}');
|
rValues.add('{action:"logout",params:["connect"]}');
|
||||||
rValues.add('{action:"test",params:["connect"]}');
|
rValues.add('{action:"test",params:["connect"]}');
|
||||||
|
rValues.add('{action:"log",params:["connect"]}');
|
||||||
rValues.add('{action:"option_values",params:["connect","report","name"]}');
|
rValues.add('{action:"option_values",params:["connect","report","name"]}');
|
||||||
rValues.add('{action:"report",params:["connect","name"]}');
|
rValues.add('{action:"report",params:["connect","name"]}');
|
||||||
rValues.add('{action:"status",params:["connect","operation"]}');
|
rValues.add('{action:"status",params:["connect","operation"]}');
|
||||||
@ -257,7 +280,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
if ACommand='arguments' then
|
if ACommand='arguments' then
|
||||||
begin
|
begin
|
||||||
result := ProcessArguments(Fields.Values['name'],RetValue,Answer,rValues);
|
result := ProcessArguments(Fields.Values['report'],RetValue,Answer,rValues);
|
||||||
if not result then
|
if not result then
|
||||||
begin
|
begin
|
||||||
Code := ErrorArguments;
|
Code := ErrorArguments;
|
||||||
@ -310,6 +333,19 @@ begin
|
|||||||
Remove(con.ConnectionID);
|
Remove(con.ConnectionID);
|
||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
|
if ACommand='log' then
|
||||||
|
begin
|
||||||
|
result := true;
|
||||||
|
Answer := 'OK';
|
||||||
|
rValues := TStringList.Create;
|
||||||
|
for i := 0 to con.Journal.count-1 do
|
||||||
|
begin
|
||||||
|
rValues.add('"'+TNIDBDM.StringAsJSON(con.Journal[i])+'"');
|
||||||
|
end;
|
||||||
|
con.Journal.Clear;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
con.Log(mtInfo,self,'Получен запрос '+ACommand);
|
||||||
if ACommand='connectStatus' then
|
if ACommand='connectStatus' then
|
||||||
begin
|
begin
|
||||||
result := true;
|
result := true;
|
||||||
@ -348,7 +384,8 @@ begin
|
|||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
rValues := TSTringList.Create;
|
rValues := TSTringList.Create;
|
||||||
rValues.Assign(cmd.Journal);
|
for i := 0 to cmd.Journal.count-1 do
|
||||||
|
rValues.add('"'+TNIDBDM.StringAsJSON(cmd.Journal[i])+'"');
|
||||||
end;
|
end;
|
||||||
code := cmd.Status;
|
code := cmd.Status;
|
||||||
if (code=StatusComplete) and assigned(cmd.Results.Data) then
|
if (code=StatusComplete) and assigned(cmd.Results.Data) then
|
||||||
@ -360,12 +397,19 @@ begin
|
|||||||
end;
|
end;
|
||||||
if ACommand='result' then
|
if ACommand='result' then
|
||||||
begin
|
begin
|
||||||
|
waitforresult(StrToIntDef(Fields.Values['wait'],0),cmd);
|
||||||
if cmd.Status=StatusComplete then
|
if cmd.Status=StatusComplete then
|
||||||
begin
|
begin
|
||||||
cmd.Results.AssignTo(Code,RetValue,Answer,rValues,iValues,ByteData);
|
cmd.Results.AssignTo(Code,RetValue,Answer,rValues,iValues,ByteData);
|
||||||
cmd.Done;
|
cmd.Done;
|
||||||
result := true;
|
result := true;
|
||||||
end
|
end
|
||||||
|
else if cmd.Status=StatusError then
|
||||||
|
begin
|
||||||
|
cmd.Results.AssignTo(Code,RetValue,Answer,rValues,iValues,ByteData);
|
||||||
|
cmd.Done;
|
||||||
|
result := false;
|
||||||
|
end
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
Code := ErrorComplete;
|
Code := ErrorComplete;
|
||||||
@ -463,6 +507,30 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TConnectionsDM.TestReport(ReportID: integer);
|
||||||
|
var
|
||||||
|
asql: string;
|
||||||
|
RName: string;
|
||||||
|
con: TBaseConnection;
|
||||||
|
cc: TCommandClass;
|
||||||
|
cmd: TReportCommand;
|
||||||
|
begin
|
||||||
|
asql := format('select cgi_name from xp_report_cgi where xp_rpt_id=%d',[ReportID]);
|
||||||
|
RName := MainCon.QueryValue(asql);
|
||||||
|
cc := TCommandCollection.Find('report',RName);
|
||||||
|
cmd := cc.Create('', MainCon,RName,@Log,'',0) as TReportCommand;
|
||||||
|
try
|
||||||
|
cmd.ReportID := ReportID;
|
||||||
|
cmd.ReportName:=RName;
|
||||||
|
cmd.FillDefaults;
|
||||||
|
cmd.Run();
|
||||||
|
|
||||||
|
finally
|
||||||
|
cmd.free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
function TConnectionsDM.ProcessLogin(UserName, UserPassword: string; out UserID: integer): boolean;
|
function TConnectionsDM.ProcessLogin(UserName, UserPassword: string; out UserID: integer): boolean;
|
||||||
var
|
var
|
||||||
ASQL: string;
|
ASQL: string;
|
||||||
@ -636,6 +704,8 @@ begin
|
|||||||
log(mtInfo,self,format('База данных %s:%d/%s Порт для соединения %d',[fDataHost,fDataPort,fDataBase,fServicePort]));
|
log(mtInfo,self,format('База данных %s:%d/%s Порт для соединения %d',[fDataHost,fDataPort,fDataBase,fServicePort]));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
procedure TConnectionsDM.Log(ALevel: TLogLevel; Sender: TObject; msg: string);
|
procedure TConnectionsDM.Log(ALevel: TLogLevel; Sender: TObject; msg: string);
|
||||||
var
|
var
|
||||||
s: string;
|
s: string;
|
||||||
@ -655,7 +725,10 @@ begin
|
|||||||
mtError: fLogger.Error(s);
|
mtError: fLogger.Error(s);
|
||||||
mtWarning: fLogger.Warning(s);
|
mtWarning: fLogger.Warning(s);
|
||||||
mtInfo: flogger.Info(s);
|
mtInfo: flogger.Info(s);
|
||||||
|
{$IFDEF DEBUG}
|
||||||
mtDebug: fLogger.Debug(s);
|
mtDebug: fLogger.Debug(s);
|
||||||
|
mtExtra: fLogger.Log(#09+s);
|
||||||
|
{$ENDIF}
|
||||||
end;
|
end;
|
||||||
except
|
except
|
||||||
end;
|
end;
|
||||||
@ -675,9 +748,11 @@ begin
|
|||||||
MainCon.OpenConnection;
|
MainCon.OpenConnection;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TConnectionsDM.Start;
|
procedure TConnectionsDM.Start(isTerminated: TChecker);
|
||||||
begin
|
begin
|
||||||
|
fTermiinateCheck := isTerminated;
|
||||||
InitBaseCon;//Input.OnIdle:=@Idle;
|
InitBaseCon;//Input.OnIdle:=@Idle;
|
||||||
|
input := TServerMainThread.Create(@log,fServicePort,fTermiinateCheck,@ProcessRequest);
|
||||||
Input.Start;
|
Input.Start;
|
||||||
fRunning:=true;
|
fRunning:=true;
|
||||||
end;
|
end;
|
||||||
|
@ -30,6 +30,7 @@ type
|
|||||||
TParamArray=Array of QWORD;
|
TParamArray=Array of QWORD;
|
||||||
TLogLevel=(mtError,mtWarning,mtInfo,mtDebug,mtExtra);
|
TLogLevel=(mtError,mtWarning,mtInfo,mtDebug,mtExtra);
|
||||||
TLogger=procedure(ALevel: TLogLevel; Sender: TObject; Msg: String ) of object;
|
TLogger=procedure(ALevel: TLogLevel; Sender: TObject; Msg: String ) of object;
|
||||||
|
TChecker=function(Sender: TObject): boolean of object;
|
||||||
EFormatException=class(Exception);
|
EFormatException=class(Exception);
|
||||||
{ TConnectionThread }
|
{ TConnectionThread }
|
||||||
|
|
||||||
|
@ -65,7 +65,6 @@ begin
|
|||||||
if AMethodName = '_' then Result := _(Params[0])
|
if AMethodName = '_' then Result := _(Params[0])
|
||||||
else
|
else
|
||||||
if AnsiSameText(AMethodName,'Log') then begin
|
if AnsiSameText(AMethodName,'Log') then begin
|
||||||
{$IFDEF DEBUG} cxlogger.TLogSystem.Loggers['fastreport'].writelog(Params[0],Params[1]); {$ENDIF}
|
|
||||||
result := true;
|
result := true;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
|
17
lms_cgi.lpr
17
lms_cgi.lpr
@ -9,8 +9,8 @@ uses
|
|||||||
{$IFDEF HASAMIGA}
|
{$IFDEF HASAMIGA}
|
||||||
athreads,
|
athreads,
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
Interfaces, Classes, SysUtils, inifiles, httpDefs, fpweb, custweb, custcgi,
|
Interfaces, Classes, SysUtils, inifiles, httpDefs, fpweb, custweb, custcgi,
|
||||||
lnetbase, tcpClient, tcpthreadhelper, extTypes, eventlog;
|
lnetbase, tcpClient, tcpthreadhelper, extTypes, eventlog;
|
||||||
|
|
||||||
Type
|
Type
|
||||||
|
|
||||||
@ -178,6 +178,18 @@ log(mtDebug,self,'Data READY');
|
|||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
if not assigned(fData) then
|
if not assigned(fData) then
|
||||||
begin
|
begin
|
||||||
|
if fmODE=3 then
|
||||||
|
case fCode of
|
||||||
|
ErrorProcessor: AResponse.Code:=503;
|
||||||
|
ErrorLogin: AResponse.Code:=401;
|
||||||
|
ErrorConnect: AResponse.Code:=401;
|
||||||
|
ErrorCommand: AResponse.Code:=501;
|
||||||
|
ErrorComplete: AResponse.Code:=202;
|
||||||
|
ErrorArguments: AResponse.Code:=400;
|
||||||
|
ErrorInternal: AResponse.Code:=500;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
AResponse.Code:=200;
|
||||||
AResponse.ContentType := 'application/json';
|
AResponse.ContentType := 'application/json';
|
||||||
AResponse.Contents.add('{');
|
AResponse.Contents.add('{');
|
||||||
AResponse.Contents.add('"type":'+aTypes[fMode]+',');
|
AResponse.Contents.add('"type":'+aTypes[fMode]+',');
|
||||||
@ -259,6 +271,7 @@ begin
|
|||||||
flogger := TEventLog.Create(self);
|
flogger := TEventLog.Create(self);
|
||||||
flogger.Identification:='lms_cgi_client';
|
flogger.Identification:='lms_cgi_client';
|
||||||
flogger.LogType:={$IFDEF LINUX}ltSystem{$ELSE}ltFile{$ENDIF};
|
flogger.LogType:={$IFDEF LINUX}ltSystem{$ELSE}ltFile{$ENDIF};
|
||||||
|
flogger.AppendContent:=true;
|
||||||
inherited Create(AOwner);
|
inherited Create(AOwner);
|
||||||
|
|
||||||
end;
|
end;
|
||||||
|
BIN
lms_cgi.obj
BIN
lms_cgi.obj
Binary file not shown.
@ -4,4 +4,4 @@ port=7079
|
|||||||
database=lms
|
database=lms
|
||||||
[PARAMS]
|
[PARAMS]
|
||||||
port=6543
|
port=6543
|
||||||
log=/var/log/nintegra/cgireport.log
|
log=./cgireport.log
|
@ -15,7 +15,7 @@
|
|||||||
<ResourceType Value="res"/>
|
<ResourceType Value="res"/>
|
||||||
</General>
|
</General>
|
||||||
<BuildModes>
|
<BuildModes>
|
||||||
<Item Name="Default" Default="True"/>
|
<Item Name="Debug" Default="True"/>
|
||||||
<Item Name="Release">
|
<Item Name="Release">
|
||||||
<CompilerOptions>
|
<CompilerOptions>
|
||||||
<Version Value="11"/>
|
<Version Value="11"/>
|
||||||
@ -166,6 +166,12 @@
|
|||||||
<OtherUnitFiles Value="reports"/>
|
<OtherUnitFiles Value="reports"/>
|
||||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||||
</SearchPaths>
|
</SearchPaths>
|
||||||
|
<Other>
|
||||||
|
<CustomOptions Value="-dDEBUG"/>
|
||||||
|
<OtherDefines Count="1">
|
||||||
|
<Define0 Value="DEBUG"/>
|
||||||
|
</OtherDefines>
|
||||||
|
</Other>
|
||||||
</CompilerOptions>
|
</CompilerOptions>
|
||||||
<Debugging>
|
<Debugging>
|
||||||
<Exceptions>
|
<Exceptions>
|
||||||
|
@ -55,6 +55,12 @@
|
|||||||
</Win32>
|
</Win32>
|
||||||
</Options>
|
</Options>
|
||||||
</Linking>
|
</Linking>
|
||||||
|
<Other>
|
||||||
|
<CustomOptions Value="-dDEBUG"/>
|
||||||
|
<OtherDefines Count="1">
|
||||||
|
<Define0 Value="DEBUG"/>
|
||||||
|
</OtherDefines>
|
||||||
|
</Other>
|
||||||
</CompilerOptions>
|
</CompilerOptions>
|
||||||
</Item>
|
</Item>
|
||||||
<Item Name="Release">
|
<Item Name="Release">
|
||||||
|
@ -1,5 +1,5 @@
|
|||||||
object CGIServerGUI: TCGIServerGUI
|
object CGIServerGUI: TCGIServerGUI
|
||||||
Left = 401
|
Left = 602
|
||||||
Height = 566
|
Height = 566
|
||||||
Top = 219
|
Top = 219
|
||||||
Width = 870
|
Width = 870
|
||||||
@ -8,7 +8,7 @@ object CGIServerGUI: TCGIServerGUI
|
|||||||
ClientWidth = 870
|
ClientWidth = 870
|
||||||
OnCreate = FormCreate
|
OnCreate = FormCreate
|
||||||
OnDestroy = FormDestroy
|
OnDestroy = FormDestroy
|
||||||
LCLVersion = '2.2.2.0'
|
LCLVersion = '3.6.0.0'
|
||||||
object Panel1: TPanel
|
object Panel1: TPanel
|
||||||
Left = 0
|
Left = 0
|
||||||
Height = 50
|
Height = 50
|
||||||
@ -25,8 +25,8 @@ object CGIServerGUI: TCGIServerGUI
|
|||||||
Top = 14
|
Top = 14
|
||||||
Width = 75
|
Width = 75
|
||||||
Caption = 'Запрос'
|
Caption = 'Запрос'
|
||||||
OnClick = SendButtonClick
|
|
||||||
TabOrder = 0
|
TabOrder = 0
|
||||||
|
OnClick = SendButtonClick
|
||||||
end
|
end
|
||||||
object StartButton: TButton
|
object StartButton: TButton
|
||||||
Left = 8
|
Left = 8
|
||||||
@ -34,8 +34,8 @@ object CGIServerGUI: TCGIServerGUI
|
|||||||
Top = 14
|
Top = 14
|
||||||
Width = 75
|
Width = 75
|
||||||
Caption = 'Запуск'
|
Caption = 'Запуск'
|
||||||
OnClick = StartButtonClick
|
|
||||||
TabOrder = 1
|
TabOrder = 1
|
||||||
|
OnClick = StartButtonClick
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
object GroupBox1: TGroupBox
|
object GroupBox1: TGroupBox
|
||||||
@ -45,14 +45,14 @@ object CGIServerGUI: TCGIServerGUI
|
|||||||
Width = 368
|
Width = 368
|
||||||
Align = alLeft
|
Align = alLeft
|
||||||
Caption = 'Запрос'
|
Caption = 'Запрос'
|
||||||
ClientHeight = 227
|
ClientHeight = 226
|
||||||
ClientWidth = 366
|
ClientWidth = 364
|
||||||
TabOrder = 1
|
TabOrder = 1
|
||||||
object Keys: TMemo
|
object Keys: TMemo
|
||||||
Left = 0
|
Left = 0
|
||||||
Height = 197
|
Height = 203
|
||||||
Top = 30
|
Top = 23
|
||||||
Width = 366
|
Width = 364
|
||||||
Align = alClient
|
Align = alClient
|
||||||
Lines.Strings = (
|
Lines.Strings = (
|
||||||
'user=nnz'
|
'user=nnz'
|
||||||
@ -62,11 +62,11 @@ object CGIServerGUI: TCGIServerGUI
|
|||||||
end
|
end
|
||||||
object edtRequest: TComboBox
|
object edtRequest: TComboBox
|
||||||
Left = 0
|
Left = 0
|
||||||
Height = 30
|
Height = 23
|
||||||
Top = 0
|
Top = 0
|
||||||
Width = 366
|
Width = 364
|
||||||
Align = alTop
|
Align = alTop
|
||||||
ItemHeight = 0
|
ItemHeight = 15
|
||||||
ItemIndex = 3
|
ItemIndex = 3
|
||||||
Items.Strings = (
|
Items.Strings = (
|
||||||
'version'
|
'version'
|
||||||
@ -91,42 +91,41 @@ object CGIServerGUI: TCGIServerGUI
|
|||||||
Width = 497
|
Width = 497
|
||||||
Align = alClient
|
Align = alClient
|
||||||
Caption = 'Ответ'
|
Caption = 'Ответ'
|
||||||
ClientHeight = 227
|
ClientHeight = 226
|
||||||
ClientWidth = 495
|
ClientWidth = 493
|
||||||
TabOrder = 2
|
TabOrder = 2
|
||||||
object edtAnswer: TEdit
|
object edtAnswer: TEdit
|
||||||
Left = 0
|
Left = 0
|
||||||
Height = 30
|
Height = 23
|
||||||
Top = 25
|
Top = 25
|
||||||
Width = 495
|
Width = 493
|
||||||
Align = alTop
|
Align = alTop
|
||||||
OnDblClick = edtAnswerDblClick
|
|
||||||
TabOrder = 0
|
TabOrder = 0
|
||||||
|
OnDblClick = edtAnswerDblClick
|
||||||
end
|
end
|
||||||
object retValues: TMemo
|
object retValues: TMemo
|
||||||
Left = 0
|
Left = 0
|
||||||
Height = 92
|
Height = 105
|
||||||
Top = 85
|
Top = 71
|
||||||
Width = 495
|
Width = 493
|
||||||
Align = alClient
|
Align = alClient
|
||||||
TabOrder = 1
|
TabOrder = 1
|
||||||
end
|
end
|
||||||
object intValues: TListBox
|
object intValues: TListBox
|
||||||
Left = 0
|
Left = 0
|
||||||
Height = 50
|
Height = 50
|
||||||
Top = 177
|
Top = 176
|
||||||
Width = 495
|
Width = 493
|
||||||
Align = alBottom
|
Align = alBottom
|
||||||
Columns = 4
|
Columns = 4
|
||||||
ItemHeight = 0
|
ItemHeight = 0
|
||||||
TabOrder = 2
|
TabOrder = 2
|
||||||
TopIndex = -1
|
|
||||||
end
|
end
|
||||||
object edtQValue: TEdit
|
object edtQValue: TEdit
|
||||||
Left = 0
|
Left = 0
|
||||||
Height = 30
|
Height = 23
|
||||||
Top = 55
|
Top = 48
|
||||||
Width = 495
|
Width = 493
|
||||||
Align = alTop
|
Align = alTop
|
||||||
TabOrder = 3
|
TabOrder = 3
|
||||||
end
|
end
|
||||||
@ -134,7 +133,7 @@ object CGIServerGUI: TCGIServerGUI
|
|||||||
Left = 0
|
Left = 0
|
||||||
Height = 25
|
Height = 25
|
||||||
Top = 0
|
Top = 0
|
||||||
Width = 495
|
Width = 493
|
||||||
Align = alTop
|
Align = alTop
|
||||||
TabOrder = 4
|
TabOrder = 4
|
||||||
end
|
end
|
||||||
@ -152,17 +151,17 @@ object CGIServerGUI: TCGIServerGUI
|
|||||||
Width = 870
|
Width = 870
|
||||||
Align = alBottom
|
Align = alBottom
|
||||||
Caption = 'Шаблоны'
|
Caption = 'Шаблоны'
|
||||||
ClientHeight = 251
|
ClientHeight = 250
|
||||||
ClientWidth = 868
|
ClientWidth = 866
|
||||||
TabOrder = 4
|
TabOrder = 4
|
||||||
object ReportsPanel: TPanel
|
object ReportsPanel: TPanel
|
||||||
Left = 0
|
Left = 0
|
||||||
Height = 50
|
Height = 50
|
||||||
Top = 201
|
Top = 200
|
||||||
Width = 868
|
Width = 866
|
||||||
Align = alBottom
|
Align = alBottom
|
||||||
ClientHeight = 50
|
ClientHeight = 50
|
||||||
ClientWidth = 868
|
ClientWidth = 866
|
||||||
TabOrder = 0
|
TabOrder = 0
|
||||||
object EditTemplate: TButton
|
object EditTemplate: TButton
|
||||||
Left = 760
|
Left = 760
|
||||||
@ -170,19 +169,27 @@ object CGIServerGUI: TCGIServerGUI
|
|||||||
Top = 11
|
Top = 11
|
||||||
Width = 100
|
Width = 100
|
||||||
Caption = 'Шаблон'
|
Caption = 'Шаблон'
|
||||||
OnClick = EditTemplateClick
|
|
||||||
TabOrder = 0
|
TabOrder = 0
|
||||||
|
OnClick = EditTemplateClick
|
||||||
|
end
|
||||||
|
object TestButton: TButton
|
||||||
|
Left = 672
|
||||||
|
Height = 25
|
||||||
|
Top = 11
|
||||||
|
Width = 75
|
||||||
|
Caption = 'Проверка'
|
||||||
|
TabOrder = 1
|
||||||
|
OnClick = TestButtonClick
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
object ReportsList: TListBox
|
object ReportsList: TListBox
|
||||||
Left = 0
|
Left = 0
|
||||||
Height = 201
|
Height = 200
|
||||||
Top = 0
|
Top = 0
|
||||||
Width = 868
|
Width = 866
|
||||||
Align = alClient
|
Align = alClient
|
||||||
ItemHeight = 0
|
ItemHeight = 0
|
||||||
TabOrder = 1
|
TabOrder = 1
|
||||||
TopIndex = -1
|
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
|
@ -17,6 +17,7 @@ type
|
|||||||
{ TCGIServerGUI }
|
{ TCGIServerGUI }
|
||||||
|
|
||||||
TCGIServerGUI = class(TForm)
|
TCGIServerGUI = class(TForm)
|
||||||
|
TestButton: TButton;
|
||||||
EditTemplate: TButton;
|
EditTemplate: TButton;
|
||||||
edtAnswer: TEdit;
|
edtAnswer: TEdit;
|
||||||
edtQValue: TEdit;
|
edtQValue: TEdit;
|
||||||
@ -40,12 +41,14 @@ type
|
|||||||
procedure StartButtonClick(Sender: TObject);
|
procedure StartButtonClick(Sender: TObject);
|
||||||
procedure FormCreate(Sender: TObject);
|
procedure FormCreate(Sender: TObject);
|
||||||
procedure FormDestroy(Sender: TObject);
|
procedure FormDestroy(Sender: TObject);
|
||||||
|
procedure TestButtonClick(Sender: TObject);
|
||||||
private
|
private
|
||||||
fLogger: TEventLog;
|
fLogger: TEventLog;
|
||||||
Server: TConnectionsDM;
|
Server: TConnectionsDM;
|
||||||
Client: TClientMainThread;
|
Client: TClientMainThread;
|
||||||
cmdDone: boolean;
|
cmdDone: boolean;
|
||||||
started: boolean;
|
started: boolean;
|
||||||
|
function IsTerminated(Sender: TObject): boolean;
|
||||||
procedure LogQuery(const qtype: integer; const command: string; const aKeys: TStrings; const code: DWORD; const Param: QWORD; const data: TParamArray);
|
procedure LogQuery(const qtype: integer; const command: string; const aKeys: TStrings; const code: DWORD; const Param: QWORD; const data: TParamArray);
|
||||||
function onAnswer(Sender: TMainThread; const mode: byte;
|
function onAnswer(Sender: TMainThread; const mode: byte;
|
||||||
const Code:DWORD; const QValue: QWORD; const Answer: string; const Values: TStrings; const iValues: TParamArray; const Data: TStream): boolean;
|
const Code:DWORD; const QValue: QWORD; const Answer: string; const Values: TStrings; const iValues: TParamArray; const Data: TStream): boolean;
|
||||||
@ -122,7 +125,7 @@ end;
|
|||||||
procedure TCGIServerGUI.StartButtonClick(Sender: TObject);
|
procedure TCGIServerGUI.StartButtonClick(Sender: TObject);
|
||||||
begin
|
begin
|
||||||
|
|
||||||
Server.Start;
|
Server.Start(@isTerminated);
|
||||||
Server.FillTemplates(ReportsList.Items);
|
Server.FillTemplates(ReportsList.Items);
|
||||||
started := true;
|
started := true;
|
||||||
Panel1.Caption := 'запущен';
|
Panel1.Caption := 'запущен';
|
||||||
@ -135,6 +138,20 @@ begin
|
|||||||
fLogger.Free;
|
fLogger.Free;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TCGIServerGUI.TestButtonClick(Sender: TObject);
|
||||||
|
var
|
||||||
|
rID: integer;
|
||||||
|
begin
|
||||||
|
rID := PtrInt(ReportsList.Items.Objects[ReportsList.ItemIndex]);
|
||||||
|
Server.TestReport(rID);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TCGIServerGUI.IsTerminated(Sender: TObject): boolean;
|
||||||
|
begin
|
||||||
|
result := false;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure TCGIServerGUI.LogQuery(const qtype: integer; const command: string;
|
procedure TCGIServerGUI.LogQuery(const qtype: integer; const command: string;
|
||||||
const aKeys: TStrings; const code: DWORD; const Param: QWORD;
|
const aKeys: TStrings; const code: DWORD; const Param: QWORD;
|
||||||
const data: TParamArray);
|
const data: TParamArray);
|
||||||
|
@ -9,7 +9,7 @@ uses
|
|||||||
|
|
||||||
implementation
|
implementation
|
||||||
uses
|
uses
|
||||||
cgiReport,applicantlist,applicantresult;
|
cgiReport,applicantlist,applicantresult, journal;
|
||||||
initialization
|
initialization
|
||||||
TCommandCollection.Register(TReportCommand);
|
TCommandCollection.Register(TReportCommand);
|
||||||
end.
|
end.
|
||||||
|
@ -81,7 +81,7 @@ end;
|
|||||||
procedure TClientMainThread.execute;
|
procedure TClientMainThread.execute;
|
||||||
begin
|
begin
|
||||||
doStart;
|
doStart;
|
||||||
log(mtExtra, self,'start main thread');
|
log(mtExtra, self,format('start main thread %s:%d',[Host,Port]));
|
||||||
Connect.Connect(Host,Port);
|
Connect.Connect(Host,Port);
|
||||||
try
|
try
|
||||||
while not terminated and not Complete do
|
while not terminated and not Complete do
|
||||||
@ -100,6 +100,7 @@ end;
|
|||||||
|
|
||||||
procedure TClientMainThread.ProcessConnect(thread: TConnectionThread);
|
procedure TClientMainThread.ProcessConnect(thread: TConnectionThread);
|
||||||
begin
|
begin
|
||||||
|
log(mtDebug,self,'ProcessConnect '+GuidToString(thread.ID));
|
||||||
thread.SendMessage(cmdRequest,1,0,self.Command,self.fFields);
|
thread.SendMessage(cmdRequest,1,0,self.Command,self.fFields);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
@ -23,12 +23,13 @@ type
|
|||||||
private
|
private
|
||||||
fOnReceive: TCommandReceived;
|
fOnReceive: TCommandReceived;
|
||||||
fOnIdle: TNotifyEvent;
|
fOnIdle: TNotifyEvent;
|
||||||
|
fTerminateCheck: TChecker;
|
||||||
function processReceive(const CommandID:DWORD; const Param:QWord; const ACommand: string; const Fields: TStrings; const iParams: TParamArray; const Data: TStream;
|
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;
|
out Code: DWORD; out RetValue: QWord; out Answer: string; out rValues: TStrings; out iValues: TParamArray; out ByteData: TStream): boolean;
|
||||||
public
|
public
|
||||||
property OnIdle: TNotifyEvent read fOnIdle write fOnIdle;
|
property OnIdle: TNotifyEvent read fOnIdle write fOnIdle;
|
||||||
procedure execute; override;
|
procedure execute; override;
|
||||||
constructor Create( ALogger: TLogger; APort: integer; OnReceive:TCommandReceived);
|
constructor Create( ALogger: TLogger; APort: integer;TermCheck: TChecker; OnReceive:TCommandReceived);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
@ -62,10 +63,10 @@ var
|
|||||||
n: integer;
|
n: integer;
|
||||||
begin
|
begin
|
||||||
doStart;
|
doStart;
|
||||||
log(mtExtra,self,'start main thread');
|
log(mtExtra,self,format('start main thread %d',[Port]));
|
||||||
Connect.Listen(Port);
|
Connect.Listen(Port);
|
||||||
n := 0;
|
n := 0;
|
||||||
while not terminated and not Complete do
|
while not terminated and not Complete and not fTerminateCheck(self) do
|
||||||
begin
|
begin
|
||||||
try
|
try
|
||||||
Connect.CallAction;
|
Connect.CallAction;
|
||||||
@ -73,9 +74,9 @@ begin
|
|||||||
except on e: Exception do
|
except on e: Exception do
|
||||||
log(mtError,e, '!!ERROR '+e.message);
|
log(mtError,e, '!!ERROR '+e.message);
|
||||||
end;
|
end;
|
||||||
sleep(10);
|
sleep(100);
|
||||||
inc(n);
|
inc(n);
|
||||||
if n>100 then
|
if n>1000 then
|
||||||
begin
|
begin
|
||||||
if Assigned(fOnIdle) then fOnIdle(self);
|
if Assigned(fOnIdle) then fOnIdle(self);
|
||||||
n :=0;
|
n :=0;
|
||||||
@ -86,9 +87,10 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
constructor TServerMainThread.Create(ALogger: TLogger; APort: integer;
|
constructor TServerMainThread.Create(ALogger: TLogger; APort: integer;
|
||||||
OnReceive: TCommandReceived);
|
TermCheck: TChecker; OnReceive: TCommandReceived);
|
||||||
begin
|
begin
|
||||||
inherited Create(TServerThread,ALogger,APort);
|
inherited Create(TServerThread,ALogger,APort);
|
||||||
|
fTerminateCheck:=TermCheck;
|
||||||
fOnReceive := OnReceive;
|
fOnReceive := OnReceive;
|
||||||
Connect.OnAccept:=@Accept;
|
Connect.OnAccept:=@Accept;
|
||||||
//FreeOnTerminate:=true;
|
//FreeOnTerminate:=true;
|
||||||
|
@ -129,6 +129,7 @@ var
|
|||||||
clt: TConnectionThread;
|
clt: TConnectionThread;
|
||||||
i: integer;
|
i: integer;
|
||||||
begin
|
begin
|
||||||
|
result := nil;
|
||||||
for i := 0 to fclients.Count-1 do
|
for i := 0 to fclients.Count-1 do
|
||||||
if TConnectionThread(fclients[i]).Socket=index then
|
if TConnectionThread(fclients[i]).Socket=index then
|
||||||
begin
|
begin
|
||||||
@ -137,7 +138,7 @@ begin
|
|||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
result := fThreadClass.Create(self,index);
|
result := fThreadClass.Create(self,index);
|
||||||
log(mtExtra,self,format('new Thread(%d) %s',[index.Handle,guidToString(result.ID)]));
|
log(mtDebug,self,format('new Thread(%d) %s',[index.Handle,guidToString(result.ID)]));
|
||||||
fclients.Add(Result);
|
fclients.Add(Result);
|
||||||
|
|
||||||
end;
|
end;
|
||||||
@ -147,13 +148,13 @@ var
|
|||||||
i: integer;
|
i: integer;
|
||||||
clt: TConnectionThread;
|
clt: TConnectionThread;
|
||||||
begin
|
begin
|
||||||
log(mtExtra,Self,'Terminate Clients');
|
log(mtDebug,Self,'Terminate Clients '+inttostr(fclients.Count));
|
||||||
for i := fclients.Count-1 downto 0 do
|
for i := fclients.Count-1 downto 0 do
|
||||||
begin
|
begin
|
||||||
sleep(0);
|
sleep(0);
|
||||||
clt := TConnectionThread(fclients[i]);
|
clt := TConnectionThread(fclients[i]);
|
||||||
try
|
try
|
||||||
log(mtExtra,self,GuidToString(clt.ID));
|
log(mtDebug,self,GuidToString(clt.ID));
|
||||||
clt.Terminate;
|
clt.Terminate;
|
||||||
clt.WaitFor;
|
clt.WaitFor;
|
||||||
clt.free;
|
clt.free;
|
||||||
@ -182,7 +183,11 @@ end;
|
|||||||
|
|
||||||
procedure TMainThread.RemoveClient(clt: TConnectionThread);
|
procedure TMainThread.RemoveClient(clt: TConnectionThread);
|
||||||
begin
|
begin
|
||||||
|
clt.Terminate;
|
||||||
|
clt.WaitFor;
|
||||||
|
log(mtDebug,self,'RemoveClient '+GuidToString(clt.ID));
|
||||||
fclients.Remove(clt);
|
fclients.Remove(clt);
|
||||||
|
clt.free;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -190,7 +195,7 @@ procedure TMainThread.dataReady(aSocket: TLSocket);
|
|||||||
var
|
var
|
||||||
clt: TConnectionThread;
|
clt: TConnectionThread;
|
||||||
begin
|
begin
|
||||||
log(mtExtra,self,'dataReady');
|
log(mtExtra,self,format('dataReady(%s:%d<-%s:%d) ',[aSocket.LocalAddress,aSocket.LocalPort,aSocket.PeerAddress,aSocket.PeerPort]));
|
||||||
if Terminated then exit;
|
if Terminated then exit;
|
||||||
|
|
||||||
clt := Client[aSocket];
|
clt := Client[aSocket];
|
||||||
@ -203,19 +208,19 @@ end;
|
|||||||
|
|
||||||
procedure TMainThread.ProcessConnect(thread: TConnectionThread);
|
procedure TMainThread.ProcessConnect(thread: TConnectionThread);
|
||||||
begin
|
begin
|
||||||
|
log(mtExtra,self,'ProcessConnect'+GUIDToString(thread.ID));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TMainThread.ProcessAccept(thread: TConnectionThread);
|
procedure TMainThread.ProcessAccept(thread: TConnectionThread);
|
||||||
begin
|
begin
|
||||||
|
log(mtExtra,self,'ProcessAccept'+GUIDToString(thread.ID));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TMainThread.Accept(aSocket: TLSocket);
|
procedure TMainThread.Accept(aSocket: TLSocket);
|
||||||
var
|
var
|
||||||
clt: TConnectionThread;
|
clt: TConnectionThread;
|
||||||
begin
|
begin
|
||||||
log(mtExtra,self,'connect');
|
log(mtExtra,self,format('accept(%s:%d<-%s:%d) ',[aSocket.LocalAddress,aSocket.LocalPort,aSocket.PeerAddress,aSocket.PeerPort]));
|
||||||
if Terminated then exit;
|
if Terminated then exit;
|
||||||
clt := Client[aSocket];
|
clt := Client[aSocket];
|
||||||
log(mtExtra,self,format('connected %s on %d ',[GUIDToString(clt.ID), aSocket.Handle]));
|
log(mtExtra,self,format('connected %s on %d ',[GUIDToString(clt.ID), aSocket.Handle]));
|
||||||
@ -229,14 +234,17 @@ var
|
|||||||
clt: TConnectionThread;
|
clt: TConnectionThread;
|
||||||
begin
|
begin
|
||||||
if terminated then exit;
|
if terminated then exit;
|
||||||
log(mtExtra,self,'disconnect');
|
log(mtDebug,self,format('disconnect(%s:%d<-%s:%d) ',[aSocket.LocalAddress,aSocket.LocalPort,aSocket.PeerAddress,aSocket.PeerPort]));
|
||||||
try
|
try
|
||||||
clt := Client[aSocket];
|
clt := Client[aSocket];
|
||||||
if clt.terminated then exit;
|
if assigned(clt) then
|
||||||
log(mtExtra,self,format('disconnected %s on %d ',[GUIDToString(clt.ID), aSocket.Handle]));
|
begin
|
||||||
clt.Terminate;
|
log(mtDebug,self,format('disconnected %s on %d ',[GUIDToString(clt.ID), aSocket.Handle]));
|
||||||
fclients.remove(clt);
|
clt.Terminate;
|
||||||
|
fclients.remove(clt);
|
||||||
|
clt.WaitFor;
|
||||||
|
clt.free;
|
||||||
|
end;
|
||||||
except on e: Exception do
|
except on e: Exception do
|
||||||
begin
|
begin
|
||||||
log(mtError,self,'!!ERROR doDisconnect '+e.Message);
|
log(mtError,self,'!!ERROR doDisconnect '+e.Message);
|
||||||
@ -249,7 +257,7 @@ procedure TMainThread.doConnect(aSocket: TLSocket);
|
|||||||
var
|
var
|
||||||
clt: TConnectionThread;
|
clt: TConnectionThread;
|
||||||
begin
|
begin
|
||||||
log(mtExtra,self,'doConnect');
|
log(mtExtra,self,format('doConnect(%s:%d<-%s:%d) ',[aSocket.LocalAddress,aSocket.LocalPort,aSocket.PeerAddress,aSocket.PeerPort]));
|
||||||
if Terminated then exit;
|
if Terminated then exit;
|
||||||
clt := Client[aSocket];
|
clt := Client[aSocket];
|
||||||
log(mtExtra,self,format('connected %s on %d ',[GUIDToString(clt.ID), aSocket.Handle]));
|
log(mtExtra,self,format('connected %s on %d ',[GUIDToString(clt.ID), aSocket.Handle]));
|
||||||
@ -1040,7 +1048,7 @@ begin
|
|||||||
fOwner := AOwner;
|
fOwner := AOwner;
|
||||||
CreateGuid(ID);
|
CreateGuid(ID);
|
||||||
recNo := 0;
|
recNo := 0;
|
||||||
log(mtExtra,'Create');
|
log(mtExtra,'Create client thread ');
|
||||||
end;
|
end;
|
||||||
|
|
||||||
destructor TConnectionThread.Destroy;
|
destructor TConnectionThread.Destroy;
|
||||||
@ -1064,7 +1072,12 @@ begin
|
|||||||
log(mtExtra,'start thread');
|
log(mtExtra,'start thread');
|
||||||
while not terminated do
|
while not terminated do
|
||||||
begin
|
begin
|
||||||
if cache.ReadReady.WaitFor(1000)<>wrSignaled then begin sleep(10);continue;end;
|
if cache.ReadReady.WaitFor(10000)<>wrSignaled then
|
||||||
|
begin
|
||||||
|
log(mtDebug,'TConnectionThread.Wait');
|
||||||
|
sleep(100);
|
||||||
|
continue;
|
||||||
|
end;
|
||||||
if terminated then break;
|
if terminated then break;
|
||||||
if not Socket.Connected then break;
|
if not Socket.Connected then break;
|
||||||
Keys := nil;
|
Keys := nil;
|
||||||
|
Loading…
Reference in New Issue
Block a user