diff --git a/baseconnection.pas b/baseconnection.pas
index 6fb85e8..88548fd 100644
--- a/baseconnection.pas
+++ b/baseconnection.pas
@@ -18,7 +18,7 @@ type
fConnectionID: string;
fTimeout: integer;
fProcessor: TNIDBDM;
-
+ fJournal: TStrings;
Commands: TStrings;
DoneCommands: TList;
fCreated,
@@ -51,7 +51,7 @@ type
property ConnectionID: string read fConnectionID;
property Processor: TNIDBDM read fProcessor;
procedure Init;
- constructor Create(AOwner: TComponent;ATimeOut: integer; aLogger: TLogger);
+ constructor Create(AOwner: TComponent;ATimeOut: integer; aLogger: TLogger; ID: string='');
destructor Destroy; override;
// 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;
@@ -63,6 +63,7 @@ type
function ProcessOptionValues(ReportName,ParamName: string; ParamValues: TStrings; out Answer: string; out RetValue: QWORD; out OptionValues: TStrings): boolean;
class function newID: string;
function calchash(data: TStream): string;
+ property Journal: TStrings read fJournal;
end;
implementation
@@ -84,10 +85,13 @@ end;
constructor TBaseConnection.Create(AOwner: TComponent; ATimeOut: integer;
- aLogger: TLogger);
+ aLogger: TLogger; ID: string);
begin
inherited Create(true);
- fConnectionID:=newID;
+ if ID='' then
+ fConnectionID:=newID
+ else
+ fConnectionID:=ID;
fTimeout:=ATimeOut;
fOwner := AOwner;
flogger := ALogger;
@@ -103,7 +107,7 @@ begin
nCommandReceived:=0;
nCommandReady:=0;
nErrors:=0;
-
+ fJournal := TStringList.Create;
end;
@@ -113,6 +117,7 @@ begin
Processor.Free;
Commands.Free;
DoneCommands.Free;
+ fJournal.free;
inherited;
end;
@@ -132,7 +137,7 @@ begin
cc := TCommandCollection.Find(ACommandClass,ACommandName);
if assigned(cc) then
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();
try
result := cmd.ParseCommand(ACode,iParam,ACommandName,Arguments,intArgs,CmdData, Errors);
@@ -145,14 +150,18 @@ begin
end;
if result then
begin
+
Commands.AddObject(ACommandName,cmd);
ID := cmd.CommandID;
retCode := Commands.Count;
+ log(mtInfo,cmd, format('%s(%s) %s поставлена в очередь %d',[cmd.CommandName, cmd.CommandSubClass, cmd.CommandID,Commands.Count]));
end
else
begin
ID := 'неверные параметры запроса';
retCode := ErrorArguments;
+ log(mtError,cmd, format('%s(%s) %s неверные параметры запроса %s',[cmd.CommandName, cmd.CommandSubClass, cmd.CommandID, Errors.CommaText]));
+
inc(nErrors);
cmd.Error:=true;
cmd.Done;
@@ -217,7 +226,7 @@ begin
fCheckConnect:=false;
d := Created;
if LastAccess>d then d := LastAccess;
- if (now()-d)*24*60>fTimeout then
+ if (ConnectionID<>'0') and ((now()-d)*24*60>fTimeout) then
begin
log(mtInfo,self,'TIMEOUT');
terminate;
@@ -251,6 +260,11 @@ end;
procedure TBaseConnection.Log(ALevel: TLogLevel; sender: TObject; msg: string);
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
flogger(ALevel,sender,msg);
end;
diff --git a/cgi_daemon.pas b/cgi_daemon.pas
index 231a862..fcba685 100644
--- a/cgi_daemon.pas
+++ b/cgi_daemon.pas
@@ -17,7 +17,7 @@ type
procedure Execute;override;
function sleepMin(n: integer): boolean;
constructor Create(AOwner: TLMSReportCGI);
-
+ function CheckTerminated(Sender: TObject): boolean;
end;
{ TLMSReportCGI }
@@ -60,6 +60,12 @@ begin
{$ENDIF}
self.logger.Identification:='LMS-Report-Service';
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);
end;
@@ -88,7 +94,9 @@ procedure TDaemonThread.Execute;
begin
fData := TConnectionsDM.CreateWithLog(fLogger);
try
- fData.Start;
+ flogger.Debug('TDaemonThread.Execute.1');
+ fData.Start(@CheckTerminated);
+ flogger.Debug('TDaemonThread.Execute.Started');
while not terminated do
begin
if sleepMin(5) then
@@ -119,6 +127,11 @@ begin
fLogger:=AOwner.Logger;
end;
+function TDaemonThread.CheckTerminated(Sender: TObject): boolean;
+begin
+ result := terminated;
+end;
+
initialization
RegisterDaemon;
diff --git a/cgi_mapper.lfm b/cgi_mapper.lfm
index 4a1f5eb..c618b03 100644
--- a/cgi_mapper.lfm
+++ b/cgi_mapper.lfm
@@ -13,8 +13,10 @@ object DaemonMapper1: TDaemonMapper1
WinBindings.ServiceType = stWin32
WinBindings.ErrorSeverity = esIgnore
WinBindings.AcceptedCodes = []
+ OnCreateInstance = DaemonMapper1DaemonDefs0CreateInstance
LogStatusReport = False
end>
+ OnCreate = DaemonMapper1Create
Left = 1065
Top = 332
end
diff --git a/cgi_mapper.pas b/cgi_mapper.pas
index 03bff21..969769c 100644
--- a/cgi_mapper.pas
+++ b/cgi_mapper.pas
@@ -8,7 +8,12 @@ uses
Classes, SysUtils, DaemonApp;
type
+
+ { TDaemonMapper1 }
+
TDaemonMapper1 = class(TDaemonMapper)
+ procedure DaemonMapper1Create(Sender: TObject);
+ procedure DaemonMapper1DaemonDefs0CreateInstance(Sender: TObject);
private
public
@@ -19,7 +24,8 @@ var
DaemonMapper1: TDaemonMapper1;
implementation
-
+uses
+ lazutf8;
procedure RegisterMapper;
begin
RegisterDaemonMapper(TDaemonMapper1)
@@ -27,6 +33,25 @@ end;
{$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
RegisterMapper;
diff --git a/cgidm.pas b/cgidm.pas
index fdbd232..d9a7a63 100644
--- a/cgidm.pas
+++ b/cgidm.pas
@@ -43,6 +43,7 @@ type
function CheckConnection: boolean;
function QueryValue(ASQL: string; Default: string=''): string;
function QueryIntValue(ASQL: string): integer;
+ function QueryDateValue(ASQL: string): TDateTime;
function GetData(ASQL: string): TDataSet;
function CheckUser(const login,password: string; out UserID: integer): boolean;
procedure OpenConnection;
@@ -330,6 +331,22 @@ begin
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;
begin
@@ -355,7 +372,7 @@ end;
procedure TNIDBDM.OpenConnection;
begin
- log(mtDebug,self,'OpenConnection');
+ log(mtDebug,self,format('OpenConnection %s:%d',[connection.RemoteHost,connection.RemotePort]));
fcon.Connected:=true;
fcon.Identify;
end;
diff --git a/cgireport.pas b/cgireport.pas
index bb6b45b..2ac4b61 100644
--- a/cgireport.pas
+++ b/cgireport.pas
@@ -85,11 +85,11 @@ var
d: TStringDynArray;
i: integer;
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);
if reportcode<>'' then
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);
if v>'' then
begin
@@ -106,7 +106,7 @@ end;
procedure TReportCommand.PrepareVars;
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);
if VarCode<>'' then
Processor.ExecuteSQL(format('select %s;',[VarCode]));
@@ -144,7 +144,7 @@ begin
vs := '';
end;
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;
end;
finally
@@ -212,13 +212,13 @@ begin
fcurrentStage := 'исполняется (инициализация)';
fileData := TMemoryStream.Create;
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
begin
fResult := TCommandData.Create(ErrorArguments,0,'Отчет не найден',nil,[],nil);
exit;
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;
log(mtInfo,'Построение отчета '+ReportTitle);
ReportProcessor.RecordID:=ReportID;
@@ -253,7 +253,7 @@ begin
exit;
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);
{$IFDEF DEBUG} (fileData as TMemoryStream).SaveToFile(format('%sout/%s_%s.pdf',[ Extractfilepath(paramstr(0)),self.CommandID,ReportTitle])); {$ENDIF}
fileData.Seek(0,soFromBeginning);
@@ -269,6 +269,19 @@ var
asql: string;
ids: string;
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
result := false;
Errors := nil;
@@ -302,7 +315,45 @@ begin
finally
free;
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;
function TReportCommand.ProcessOptionValues(ParamName: string; out
diff --git a/commandcol.pas b/commandcol.pas
index 8601c50..540ea52 100644
--- a/commandcol.pas
+++ b/commandcol.pas
@@ -125,6 +125,8 @@ end;
constructor TCommand.Create(ID: string; aProcessor: TNIDBDM; ASubClass: string;
aLogger: TLogger; AUser: string; IDUser: integer);
begin
+ if assigned(aLogger) then
+ aLogger(mtExtra,self,'CREATE '+self.ClassName);
fProcessor := AProcessor;
fSubClass := ASubClass;
fStatus:=StatusWaiting;
@@ -149,6 +151,7 @@ end;
procedure TCommand.doRun;
begin
+ log(mtInfo,format('%s(%s) %s - начато выполнение',[commandName,CommandSubClass, commandID]));
fStatus:=StatusProcessing;
fcurrentStage := 'исполняется';
try
@@ -156,11 +159,13 @@ begin
begin
fStatus:=StatusComplete;
fcurrentStage := 'завершена';
+ log(mtInfo,format('%s(%s) %s - выполнена',[commandName,CommandSubClass, commandID]));
end
else
begin
fStatus := StatusError;
fcurrentStage := 'завершена c ошибкой';
+ log(mtInfo,format('%s(%s) %s - ошибка',[commandName,CommandSubClass, commandID]));
end;
except on e: Exception do
diff --git a/connectionsdmunit.lfm b/connectionsdmunit.lfm
index a02bef0..6b206e3 100644
--- a/connectionsdmunit.lfm
+++ b/connectionsdmunit.lfm
@@ -4,7 +4,7 @@ object ConnectionsDM: TConnectionsDM
OldCreateOrder = False
Height = 150
HorizontalOffset = 738
- VerticalOffset = 342
+ VerticalOffset = 344
Width = 533
object Process1: TProcess
Active = False
diff --git a/connectionsdmunit.pas b/connectionsdmunit.pas
index cd8fb77..dfcee80 100644
--- a/connectionsdmunit.pas
+++ b/connectionsdmunit.pas
@@ -34,8 +34,9 @@ type
fLogger: TEventLog;
fTimeOut: integer;
fRunning: boolean;
+ fTermiinateCheck: TChecker;
function getConnection(ID: string): TBaseConnection;
- function NewConnection: TBaseConnection;
+ function NewConnection(ID: string=''): TBaseConnection;
procedure Remove(con: TBaseConnection); overload;
procedure Remove(ID: string); overload;
procedure ClearConnections;
@@ -55,7 +56,7 @@ type
procedure Log(ALevel: TLogLevel; Sender: TObject; msg: string);
procedure LogError(Sender: TObject; e: Exception; Command: string);
procedure InitBaseCon;
- procedure Start;
+ procedure Start(isTerminated: TChecker);
procedure Stop;
procedure Idle(Sender: TObject);
property Running: boolean read fRunning;
@@ -65,6 +66,7 @@ type
constructor CreateWithLog(ALogger: TEventLog);
procedure FillTemplates(RepList: TStrings);
procedure EditTemplate(ReportID: integer);
+ procedure TestReport(ReportID: integer);
function CalcHash(Data: TStream): string;
end;
@@ -82,12 +84,20 @@ uses
{ TConnectionsDM }
procedure TConnectionsDM.DataModuleCreate(Sender: TObject);
+var
+ con: TBaseConnection;
begin
fRunning := false;
conList := TList.Create;
MainCon := TNIDBDM.CreateWithLogger(@log);
LoadConfig;
- input := TServerMainThread.Create(@log,fServicePort,@ProcessRequest);
+ input := nil;
+ {$IFDEF DEBUG}
+ con := NewConnection('0');
+ con.User:='anonymous';
+ con.UserID := 0;
+ con.Start;
+ {$ENDIF}
end;
procedure TConnectionsDM.DataModuleDestroy(Sender: TObject);
@@ -99,8 +109,10 @@ begin
begin
Input.Terminate;
Input.WaitFor;
+ Input.Free;
end;
- Input.Free;
+
+
MainCon.Free;
conList.Free;
@@ -120,13 +132,13 @@ begin
result := nil;
end;
-function TConnectionsDM.NewConnection: TBaseConnection;
+function TConnectionsDM.NewConnection(ID: string): TBaseConnection;
var
g: TGUID;
s: string;
i: integer;
begin
- result := TBaseConnection.Create(self,fTimeOut,@Log);
+ result := TBaseConnection.Create(self,fTimeOut,@Log,ID);
conlist.add(result);
result.Host:=DataHost;
result.port:=DataPort;
@@ -209,14 +221,24 @@ function TConnectionsDM.ProcessRequest(Sender: TMainThread;
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;
+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
UserID: integer;
con: TBaseConnection;
userName,conID,cmdID: string;
cmd: TCommand;
+ i: integer;
begin
try
- log(mtDebug, Self,'Обработка запроса '+ACommand);
+ log(mtInfo, Self,'Обработка запроса '+ACommand);
ClearTerminated;
result := false;
RetValue := 0;
@@ -240,10 +262,11 @@ begin
rvalues.Add('"help"');
rvalues.Add('"version"');
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:"logout",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:"report",params:["connect","name"]}');
rValues.add('{action:"status",params:["connect","operation"]}');
@@ -257,7 +280,7 @@ begin
end;
if ACommand='arguments' then
begin
- result := ProcessArguments(Fields.Values['name'],RetValue,Answer,rValues);
+ result := ProcessArguments(Fields.Values['report'],RetValue,Answer,rValues);
if not result then
begin
Code := ErrorArguments;
@@ -310,6 +333,19 @@ begin
Remove(con.ConnectionID);
exit;
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
begin
result := true;
@@ -348,7 +384,8 @@ begin
else
begin
rValues := TSTringList.Create;
- rValues.Assign(cmd.Journal);
+ for i := 0 to cmd.Journal.count-1 do
+ rValues.add('"'+TNIDBDM.StringAsJSON(cmd.Journal[i])+'"');
end;
code := cmd.Status;
if (code=StatusComplete) and assigned(cmd.Results.Data) then
@@ -360,12 +397,19 @@ begin
end;
if ACommand='result' then
begin
+ waitforresult(StrToIntDef(Fields.Values['wait'],0),cmd);
if cmd.Status=StatusComplete then
begin
cmd.Results.AssignTo(Code,RetValue,Answer,rValues,iValues,ByteData);
cmd.Done;
result := true;
end
+ else if cmd.Status=StatusError then
+ begin
+ cmd.Results.AssignTo(Code,RetValue,Answer,rValues,iValues,ByteData);
+ cmd.Done;
+ result := false;
+ end
else
begin
Code := ErrorComplete;
@@ -463,6 +507,30 @@ begin
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;
var
ASQL: string;
@@ -636,6 +704,8 @@ begin
log(mtInfo,self,format('База данных %s:%d/%s Порт для соединения %d',[fDataHost,fDataPort,fDataBase,fServicePort]));
end;
+
+
procedure TConnectionsDM.Log(ALevel: TLogLevel; Sender: TObject; msg: string);
var
s: string;
@@ -655,7 +725,10 @@ begin
mtError: fLogger.Error(s);
mtWarning: fLogger.Warning(s);
mtInfo: flogger.Info(s);
+ {$IFDEF DEBUG}
mtDebug: fLogger.Debug(s);
+ mtExtra: fLogger.Log(#09+s);
+ {$ENDIF}
end;
except
end;
@@ -675,9 +748,11 @@ begin
MainCon.OpenConnection;
end;
-procedure TConnectionsDM.Start;
+procedure TConnectionsDM.Start(isTerminated: TChecker);
begin
+ fTermiinateCheck := isTerminated;
InitBaseCon;//Input.OnIdle:=@Idle;
+ input := TServerMainThread.Create(@log,fServicePort,fTermiinateCheck,@ProcessRequest);
Input.Start;
fRunning:=true;
end;
diff --git a/exttypes.pas b/exttypes.pas
index 5eed2ea..4288a9c 100644
--- a/exttypes.pas
+++ b/exttypes.pas
@@ -30,6 +30,7 @@ type
TParamArray=Array of QWORD;
TLogLevel=(mtError,mtWarning,mtInfo,mtDebug,mtExtra);
TLogger=procedure(ALevel: TLogLevel; Sender: TObject; Msg: String ) of object;
+ TChecker=function(Sender: TObject): boolean of object;
EFormatException=class(Exception);
{ TConnectionThread }
diff --git a/fr_utils.pas b/fr_utils.pas
index fb260e5..c0e5d85 100644
--- a/fr_utils.pas
+++ b/fr_utils.pas
@@ -65,7 +65,6 @@ begin
if AMethodName = '_' then Result := _(Params[0])
else
if AnsiSameText(AMethodName,'Log') then begin
- {$IFDEF DEBUG} cxlogger.TLogSystem.Loggers['fastreport'].writelog(Params[0],Params[1]); {$ENDIF}
result := true;
end
else
diff --git a/lms_cgi.lpr b/lms_cgi.lpr
index 92a379d..6e321de 100644
--- a/lms_cgi.lpr
+++ b/lms_cgi.lpr
@@ -9,8 +9,8 @@ uses
{$IFDEF HASAMIGA}
athreads,
{$ENDIF}
- Interfaces, Classes, SysUtils, inifiles, httpDefs, fpweb, custweb, custcgi,
- lnetbase, tcpClient, tcpthreadhelper, extTypes, eventlog;
+ Interfaces, Classes, SysUtils, inifiles, httpDefs, fpweb, custweb, custcgi,
+ lnetbase, tcpClient, tcpthreadhelper, extTypes, eventlog;
Type
@@ -178,6 +178,18 @@ log(mtDebug,self,'Data READY');
{$ENDIF}
if not assigned(fData) then
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.Contents.add('{');
AResponse.Contents.add('"type":'+aTypes[fMode]+',');
@@ -259,6 +271,7 @@ begin
flogger := TEventLog.Create(self);
flogger.Identification:='lms_cgi_client';
flogger.LogType:={$IFDEF LINUX}ltSystem{$ELSE}ltFile{$ENDIF};
+ flogger.AppendContent:=true;
inherited Create(AOwner);
end;
diff --git a/lms_cgi.obj b/lms_cgi.obj
index 939c58e..c802a7d 100644
Binary files a/lms_cgi.obj and b/lms_cgi.obj differ
diff --git a/lms_cgi_server.ini b/lms_cgi_server.ini
index 68a6798..a842b54 100644
--- a/lms_cgi_server.ini
+++ b/lms_cgi_server.ini
@@ -4,4 +4,4 @@ port=7079
database=lms
[PARAMS]
port=6543
-log=/var/log/nintegra/cgireport.log
\ No newline at end of file
+log=./cgireport.log
\ No newline at end of file
diff --git a/lms_cgi_server.lpi b/lms_cgi_server.lpi
index bdb0985..4bc4e62 100644
--- a/lms_cgi_server.lpi
+++ b/lms_cgi_server.lpi
@@ -15,7 +15,7 @@
- -
@@ -166,6 +166,12 @@
+
+
+
+
+
+
diff --git a/lmsreport.lpi b/lmsreport.lpi
index 8bd8e2c..8da44ac 100644
--- a/lmsreport.lpi
+++ b/lmsreport.lpi
@@ -55,6 +55,12 @@
+
+
+
+
+
+
-
diff --git a/maintcpserver.lfm b/maintcpserver.lfm
index 031ca8b..ab24c7f 100644
--- a/maintcpserver.lfm
+++ b/maintcpserver.lfm
@@ -1,5 +1,5 @@
object CGIServerGUI: TCGIServerGUI
- Left = 401
+ Left = 602
Height = 566
Top = 219
Width = 870
@@ -8,7 +8,7 @@ object CGIServerGUI: TCGIServerGUI
ClientWidth = 870
OnCreate = FormCreate
OnDestroy = FormDestroy
- LCLVersion = '2.2.2.0'
+ LCLVersion = '3.6.0.0'
object Panel1: TPanel
Left = 0
Height = 50
@@ -25,8 +25,8 @@ object CGIServerGUI: TCGIServerGUI
Top = 14
Width = 75
Caption = 'Запрос'
- OnClick = SendButtonClick
TabOrder = 0
+ OnClick = SendButtonClick
end
object StartButton: TButton
Left = 8
@@ -34,8 +34,8 @@ object CGIServerGUI: TCGIServerGUI
Top = 14
Width = 75
Caption = 'Запуск'
- OnClick = StartButtonClick
TabOrder = 1
+ OnClick = StartButtonClick
end
end
object GroupBox1: TGroupBox
@@ -45,14 +45,14 @@ object CGIServerGUI: TCGIServerGUI
Width = 368
Align = alLeft
Caption = 'Запрос'
- ClientHeight = 227
- ClientWidth = 366
+ ClientHeight = 226
+ ClientWidth = 364
TabOrder = 1
object Keys: TMemo
Left = 0
- Height = 197
- Top = 30
- Width = 366
+ Height = 203
+ Top = 23
+ Width = 364
Align = alClient
Lines.Strings = (
'user=nnz'
@@ -62,11 +62,11 @@ object CGIServerGUI: TCGIServerGUI
end
object edtRequest: TComboBox
Left = 0
- Height = 30
+ Height = 23
Top = 0
- Width = 366
+ Width = 364
Align = alTop
- ItemHeight = 0
+ ItemHeight = 15
ItemIndex = 3
Items.Strings = (
'version'
@@ -91,42 +91,41 @@ object CGIServerGUI: TCGIServerGUI
Width = 497
Align = alClient
Caption = 'Ответ'
- ClientHeight = 227
- ClientWidth = 495
+ ClientHeight = 226
+ ClientWidth = 493
TabOrder = 2
object edtAnswer: TEdit
Left = 0
- Height = 30
+ Height = 23
Top = 25
- Width = 495
+ Width = 493
Align = alTop
- OnDblClick = edtAnswerDblClick
TabOrder = 0
+ OnDblClick = edtAnswerDblClick
end
object retValues: TMemo
Left = 0
- Height = 92
- Top = 85
- Width = 495
+ Height = 105
+ Top = 71
+ Width = 493
Align = alClient
TabOrder = 1
end
object intValues: TListBox
Left = 0
Height = 50
- Top = 177
- Width = 495
+ Top = 176
+ Width = 493
Align = alBottom
Columns = 4
ItemHeight = 0
TabOrder = 2
- TopIndex = -1
end
object edtQValue: TEdit
Left = 0
- Height = 30
- Top = 55
- Width = 495
+ Height = 23
+ Top = 48
+ Width = 493
Align = alTop
TabOrder = 3
end
@@ -134,7 +133,7 @@ object CGIServerGUI: TCGIServerGUI
Left = 0
Height = 25
Top = 0
- Width = 495
+ Width = 493
Align = alTop
TabOrder = 4
end
@@ -152,17 +151,17 @@ object CGIServerGUI: TCGIServerGUI
Width = 870
Align = alBottom
Caption = 'Шаблоны'
- ClientHeight = 251
- ClientWidth = 868
+ ClientHeight = 250
+ ClientWidth = 866
TabOrder = 4
object ReportsPanel: TPanel
Left = 0
Height = 50
- Top = 201
- Width = 868
+ Top = 200
+ Width = 866
Align = alBottom
ClientHeight = 50
- ClientWidth = 868
+ ClientWidth = 866
TabOrder = 0
object EditTemplate: TButton
Left = 760
@@ -170,19 +169,27 @@ object CGIServerGUI: TCGIServerGUI
Top = 11
Width = 100
Caption = 'Шаблон'
- OnClick = EditTemplateClick
TabOrder = 0
+ OnClick = EditTemplateClick
+ end
+ object TestButton: TButton
+ Left = 672
+ Height = 25
+ Top = 11
+ Width = 75
+ Caption = 'Проверка'
+ TabOrder = 1
+ OnClick = TestButtonClick
end
end
object ReportsList: TListBox
Left = 0
- Height = 201
+ Height = 200
Top = 0
- Width = 868
+ Width = 866
Align = alClient
ItemHeight = 0
TabOrder = 1
- TopIndex = -1
end
end
end
diff --git a/maintcpserver.pas b/maintcpserver.pas
index 08c0098..1ea70b5 100644
--- a/maintcpserver.pas
+++ b/maintcpserver.pas
@@ -17,6 +17,7 @@ type
{ TCGIServerGUI }
TCGIServerGUI = class(TForm)
+ TestButton: TButton;
EditTemplate: TButton;
edtAnswer: TEdit;
edtQValue: TEdit;
@@ -40,12 +41,14 @@ type
procedure StartButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
+ procedure TestButtonClick(Sender: TObject);
private
fLogger: TEventLog;
Server: TConnectionsDM;
Client: TClientMainThread;
cmdDone: 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);
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;
@@ -122,7 +125,7 @@ end;
procedure TCGIServerGUI.StartButtonClick(Sender: TObject);
begin
- Server.Start;
+ Server.Start(@isTerminated);
Server.FillTemplates(ReportsList.Items);
started := true;
Panel1.Caption := 'запущен';
@@ -135,6 +138,20 @@ begin
fLogger.Free;
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;
const aKeys: TStrings; const code: DWORD; const Param: QWORD;
const data: TParamArray);
diff --git a/reports/allreportsunit.pas b/reports/allreportsunit.pas
index f10afed..98aed63 100644
--- a/reports/allreportsunit.pas
+++ b/reports/allreportsunit.pas
@@ -9,7 +9,7 @@ uses
implementation
uses
- cgiReport,applicantlist,applicantresult;
+ cgiReport,applicantlist,applicantresult, journal;
initialization
TCommandCollection.Register(TReportCommand);
end.
diff --git a/tcpclient.pas b/tcpclient.pas
index bde57cd..ee9cf15 100644
--- a/tcpclient.pas
+++ b/tcpclient.pas
@@ -81,7 +81,7 @@ end;
procedure TClientMainThread.execute;
begin
doStart;
- log(mtExtra, self,'start main thread');
+ log(mtExtra, self,format('start main thread %s:%d',[Host,Port]));
Connect.Connect(Host,Port);
try
while not terminated and not Complete do
@@ -100,6 +100,7 @@ end;
procedure TClientMainThread.ProcessConnect(thread: TConnectionThread);
begin
+ log(mtDebug,self,'ProcessConnect '+GuidToString(thread.ID));
thread.SendMessage(cmdRequest,1,0,self.Command,self.fFields);
end;
diff --git a/tcpserver.pas b/tcpserver.pas
index fc6ab57..8d907c4 100644
--- a/tcpserver.pas
+++ b/tcpserver.pas
@@ -23,12 +23,13 @@ type
private
fOnReceive: TCommandReceived;
fOnIdle: TNotifyEvent;
+ fTerminateCheck: TChecker;
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);
+ constructor Create( ALogger: TLogger; APort: integer;TermCheck: TChecker; OnReceive:TCommandReceived);
end;
implementation
@@ -62,10 +63,10 @@ var
n: integer;
begin
doStart;
- log(mtExtra,self,'start main thread');
+ log(mtExtra,self,format('start main thread %d',[Port]));
Connect.Listen(Port);
n := 0;
- while not terminated and not Complete do
+ while not terminated and not Complete and not fTerminateCheck(self) do
begin
try
Connect.CallAction;
@@ -73,9 +74,9 @@ begin
except on e: Exception do
log(mtError,e, '!!ERROR '+e.message);
end;
- sleep(10);
+ sleep(100);
inc(n);
- if n>100 then
+ if n>1000 then
begin
if Assigned(fOnIdle) then fOnIdle(self);
n :=0;
@@ -86,9 +87,10 @@ begin
end;
constructor TServerMainThread.Create(ALogger: TLogger; APort: integer;
- OnReceive: TCommandReceived);
+ TermCheck: TChecker; OnReceive: TCommandReceived);
begin
inherited Create(TServerThread,ALogger,APort);
+ fTerminateCheck:=TermCheck;
fOnReceive := OnReceive;
Connect.OnAccept:=@Accept;
//FreeOnTerminate:=true;
diff --git a/tcpthreadhelper.pas b/tcpthreadhelper.pas
index b6325e8..3f6761c 100644
--- a/tcpthreadhelper.pas
+++ b/tcpthreadhelper.pas
@@ -129,6 +129,7 @@ var
clt: TConnectionThread;
i: integer;
begin
+ result := nil;
for i := 0 to fclients.Count-1 do
if TConnectionThread(fclients[i]).Socket=index then
begin
@@ -137,7 +138,7 @@ begin
exit;
end;
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);
end;
@@ -147,13 +148,13 @@ var
i: integer;
clt: TConnectionThread;
begin
- log(mtExtra,Self,'Terminate Clients');
+ log(mtDebug,Self,'Terminate Clients '+inttostr(fclients.Count));
for i := fclients.Count-1 downto 0 do
begin
sleep(0);
clt := TConnectionThread(fclients[i]);
try
- log(mtExtra,self,GuidToString(clt.ID));
+ log(mtDebug,self,GuidToString(clt.ID));
clt.Terminate;
clt.WaitFor;
clt.free;
@@ -182,7 +183,11 @@ end;
procedure TMainThread.RemoveClient(clt: TConnectionThread);
begin
+ clt.Terminate;
+ clt.WaitFor;
+ log(mtDebug,self,'RemoveClient '+GuidToString(clt.ID));
fclients.Remove(clt);
+ clt.free;
end;
@@ -190,7 +195,7 @@ procedure TMainThread.dataReady(aSocket: TLSocket);
var
clt: TConnectionThread;
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;
clt := Client[aSocket];
@@ -203,19 +208,19 @@ end;
procedure TMainThread.ProcessConnect(thread: TConnectionThread);
begin
-
+ log(mtExtra,self,'ProcessConnect'+GUIDToString(thread.ID));
end;
procedure TMainThread.ProcessAccept(thread: TConnectionThread);
begin
-
+ log(mtExtra,self,'ProcessAccept'+GUIDToString(thread.ID));
end;
procedure TMainThread.Accept(aSocket: TLSocket);
var
clt: TConnectionThread;
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;
clt := Client[aSocket];
log(mtExtra,self,format('connected %s on %d ',[GUIDToString(clt.ID), aSocket.Handle]));
@@ -229,14 +234,17 @@ var
clt: TConnectionThread;
begin
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
clt := Client[aSocket];
- if clt.terminated then exit;
- log(mtExtra,self,format('disconnected %s on %d ',[GUIDToString(clt.ID), aSocket.Handle]));
- clt.Terminate;
- fclients.remove(clt);
-
+ if assigned(clt) then
+ begin
+ log(mtDebug,self,format('disconnected %s on %d ',[GUIDToString(clt.ID), aSocket.Handle]));
+ clt.Terminate;
+ fclients.remove(clt);
+ clt.WaitFor;
+ clt.free;
+ end;
except on e: Exception do
begin
log(mtError,self,'!!ERROR doDisconnect '+e.Message);
@@ -249,7 +257,7 @@ procedure TMainThread.doConnect(aSocket: TLSocket);
var
clt: TConnectionThread;
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;
clt := Client[aSocket];
log(mtExtra,self,format('connected %s on %d ',[GUIDToString(clt.ID), aSocket.Handle]));
@@ -1040,7 +1048,7 @@ begin
fOwner := AOwner;
CreateGuid(ID);
recNo := 0;
- log(mtExtra,'Create');
+ log(mtExtra,'Create client thread ');
end;
destructor TConnectionThread.Destroy;
@@ -1064,7 +1072,12 @@ begin
log(mtExtra,'start thread');
while not terminated do
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 not Socket.Connected then break;
Keys := nil;