alexey.zablotskiy/LMS-2_ReportAPI
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

logs

Browse Source
This commit is contained in:
Алексей Заблоцкий 2023-11-17 12:46:39 +03:00
parent 6f83f16929
commit 2b6d2c161b
9 changed files with 138 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
baseconnection.pas
View File

@ -38,6 +38,8 @@ type
UserID: integer;
LastAccess: TDateTime;
procedure Log(ALevel:TLogLevel;sender: TObject; msg: string);
procedure LogError(Sender: TObject; e: Exception; Command: string);
property Created: TDateTime read fCreated;
property LastReceive: TDateTime read fCommandReceived;
property LastComplete: TDateTime read fCommandCompleted;
@ -130,7 +132,15 @@ begin
begin
cmd := cc.Create(self.newID, self.Processor,ACommandName,fLogger,User,UserID);
cmd.AccessTime:=NOW();
try
result := cmd.ParseCommand(ACode,iParam,ACommandName,Arguments,intArgs,CmdData, Errors);
except on e: Exception do
begin
LogError(self,e,format('ParseCommand(%s,%s)',[ACommandClass, ACommandName]));
result := false;
end;
end;
if result then
begin
Commands.AddObject(ACommandName,cmd);
@ -152,13 +162,27 @@ begin
end
else
begin
inc(nErrors);
result := false;
ID := format('Неизвестная команда %s(%s)',[ACommandClass, ACommandName]);
log(mtWarning,self,ID);
retCode := ErrorCommand;
end;
end;
function TBaseConnection.RunCommand(ACommand: TCommand): boolean;
begin
log(mtDebug,self,format('Запуск на исполнение %s_%s %s',[ACommand.CommandName,ACommand.CommandSubClass, ACommand.CommandID]));
try
ACommand.doRun();
log(mtDebug,Self,'complete '+ACommand.CommandID);
log(mtDebug,Self,'Завершена '+ACommand.CommandID);
except on e: Exception do
begin
LogError(self,e,format('Command %s',[ACommand.CommandID]));
end;
end;
fCommandCompleted:=Now();
inc(nCommandReady);
end;
@ -229,6 +253,12 @@ begin
flogger(ALevel,sender,msg);
end;
procedure TBaseConnection.LogError(Sender: TObject; e: Exception;
Command: string);
begin
log(mtError,Sender,format('%s вызвала ошибку %s(%s) ',[Command, e.classname,e.message]));
end;
procedure TBaseConnection.Execute;
var
cmd: TCommand;
@ -239,7 +269,6 @@ begin
while Commands.Count>0 do
begin
cmd := Commands.Objects[0] as TCommand;
log(mtDebug,self,format('run(%s) %s %s ',[cmd.CommandID,cmd.CommandName, cmd.CommandSubClass]));
try
RunCommand(cmd);
finally
@ -260,15 +289,32 @@ function TBaseConnection.ProcessOptionValues(ReportName, ParamName: string;
var
c: TCommand;
tmp: TStrings;
cc: TCommandClass;
begin
with TCommandCollection.Find('report',Reportname).Create('', self.Processor,ReportName,fLogger,User,UserID) do
try
ParseCommand(0,0,ReportName,ParamValues,[],nil,tmp);
if assigned(tmp) then FreeAndNil(tmp);
result := ProcessOptionValues(ParamName,answer,RetValue,OptionValues);
finally
free
end;
cc := TCommandCollection.Find('report',Reportname);
if assigned(cc) then
try
with cc.Create('', self.Processor,ReportName,fLogger,User,UserID) do
try
ParseCommand(0,0,ReportName,ParamValues,[],nil,tmp);
if assigned(tmp) then FreeAndNil(tmp);
result := ProcessOptionValues(ParamName,answer,RetValue,OptionValues);
finally
free
end;
except on e: Exception do
begin
LogError(self,e,format('ProcessOptionValues(report=%s,param=%s)',[ReportName,ParamName]));
result := false;
Answer := e.Message;
end;
end
else
begin
result := false;
answer := 'Отчет не найден '+ReportName;
end;
end;
class function TBaseConnection.newID: string;

10
cgi_daemon.pas
View File

@ -6,7 +6,6 @@ interface
uses
Classes, SysUtils, DaemonApp, ConnectionsDmUnit,eventlog;
type
TLMSReportCGI=class;
{ TDaemonThread }
@ -18,6 +17,7 @@ type
procedure Execute;override;
function sleepMin(n: integer): boolean;
constructor Create(AOwner: TLMSReportCGI);
end;
{ TLMSReportCGI }
@ -38,7 +38,7 @@ var
implementation
uses
LazLogger;
LazLogger, extTypes;
procedure RegisterDaemon;
begin
RegisterDaemonClass(TLMSReportCGI)
@ -70,14 +70,14 @@ end;
procedure TLMSReportCGI.DataModuleStart(Sender: TCustomDaemon; var OK: Boolean);
begin
logger.Info('Запуск сервиса');
logger.Info('Запуск сервиса '+version);
workThread.Start;
OK := true;
end;
procedure TLMSReportCGI.DataModuleStop(Sender: TCustomDaemon; var OK: Boolean);
begin
debugln('Останов сервиса');
logger.Info('Останов сервиса '+version);
workThread.Terminate;
workThread.WaitFor;
end;
@ -86,7 +86,6 @@ end;
procedure TDaemonThread.Execute;
begin
flogger.debug('TDaemonThread.Execute');
fData := TConnectionsDM.CreateWithLog(fLogger);
try
fData.Start;
@ -99,7 +98,6 @@ begin
finally
fData.free;
end;
flogger.debug('TDaemonThread.Execute.complete');
end;
function TDaemonThread.sleepMin(n: integer): boolean;

14
cgireport.pas
View File

@ -127,7 +127,7 @@ var
vs: string;
vi: integer;
begin
log(mtDebug,'FillVars');
try
script := format('insert into tmp_report_variables(name,value_string,var_type) values(''UserName'',%s,0); ',[TNIDBDM.StringAsSQL(UserName)]);
ASQL := format(Q_varlist,[ReportID,0]);
with Processor.GetData(ASQL) do
@ -155,7 +155,6 @@ begin
try
while not eof do
begin
log(mtDebug, FieldByName('name').asString);
q := FieldByName('query').AsString;
UpdateCodeWithArguments(q);
try
@ -171,8 +170,17 @@ begin
finally
free;
end;
if script<>'' then
Processor.ExecuteSQL(script);
except on e: Exception do
begin
LogError(e,'FillVars');
raise;
end;
end;
end;
procedure TReportCommand.OnFillVariables(AVariables: TxpMemParamManager);
@ -246,7 +254,7 @@ begin
end;
fResult := TCommandData.Create(0,fileData.size,ReportTitle+'.pdf',['type=application/pdf'],[],fileData);
fileData.Seek(0,soFromBeginning);
(fileData as TMemoryStream).SaveToFile(Extractfilepath(paramstr(0))+'out/report.pdf');
{$IFDEF DEBUG} (fileData as TMemoryStream).SaveToFile(format('%sout/%s_%s.pdf',[ Extractfilepath(paramstr(0)),self.CommandID,ReportTitle])); {$ENDIF}
fileData.Seek(0,soFromBeginning);
result := true;
finally

7
commandcol.pas
View File

@ -51,6 +51,7 @@ type
function ParseCommand(ACode: DWORD; iParam: QWORD; ACommand: string; Args: TStrings; intArgs: TParamArray; CmdData: TStream; out Errors: TStrings): boolean;
function ParseArguments(Args: TStrings; out Errors: TStrings): boolean; virtual; abstract;
procedure Log(ALevel:TLogLevel; msg: string);
procedure logError(e:Exception; Command: string);
function ProcessOptionValues(ParamName: string; out Answer: string; out RetValue: QWORD; out OptionValues: TStrings): boolean; virtual; abstract;
end;
TCommandClass=class of TCommand;
@ -166,6 +167,7 @@ begin
Results.Free;
fResult := TCommandData.Create(ErrorInternal,0,e.ClassName,[e.Message],[],nil);
Results.Name:=e.Message;
logError(e,'doRun');
end;
end;
end;
@ -190,6 +192,11 @@ begin
fLogger(ALevel,self, self.CommandID+#09+msg)
end;
procedure TCommand.logError(e: Exception; Command: string);
begin
log(mtError,format('%s вызвала ошибку %s(%s)',[Command,e.classname,e.Message]));
end;
initialization
TCommandCollection.Init;
finalization

0
commit_info.sh Normal file → Executable file
View File

67
connectionsdmunit.pas
View File

@ -53,6 +53,7 @@ type
property DataBase: string read fDataBase;
property Logger: TEventLog read fLogger write fLogger;
procedure Log(ALevel: TLogLevel; Sender: TObject; msg: string);
procedure LogError(Sender: TObject; e: Exception; Command: string);
procedure InitBaseCon;
procedure Start;
procedure Stop;
@ -130,7 +131,7 @@ begin
result.Host:=DataHost;
result.port:=DataPort;
result.DataBase:=DataBase;
log(mtDebug, self, 'New '+result.ConnectionID);
log(mtDebug, self, 'Новое соединение с БД '+result.ConnectionID);
result.Init;
end;
@ -143,7 +144,7 @@ begin
for i := conList.Count-1 downto 0 do
if TBaseConnection(conlist[i])=con then
begin
log(mtDebug,self,'terminate '+con.ConnectionID);
log(mtDebug,self,'Закрытие соединения '+con.ConnectionID);
TBaseConnection(conlist[i]).terminate;
exit;
end;
@ -157,7 +158,7 @@ begin
for i := conList.Count-1 downto 0 do
if TBaseConnection(conlist[i]).ConnectionID=ID then
begin
log(mtDebug,self,'terminate '+ID);
log(mtDebug,self,'Закрытие соединения '+ID);
TBaseConnection(conlist[i]).terminate;
exit;
end;
@ -169,7 +170,7 @@ var
i: integer;
con: TBaseConnection;
begin
log(mtDebug, self,'ClearConnections');
log(mtExtra, self,'ClearConnections');
for i := 0 to conList.Count-1 do
begin
con := TBaseConnection(conlist[i]);
@ -185,13 +186,13 @@ var
i: integer;
con: TBaseConnection;
begin
log(mtDebug,self,'ClearTerminated');
log(mtExtra,self,'ClearTerminated');
for i := conlist.Count-1 downto 0 do
begin
con := TBaseConnection(conlist[i]);
if con.Finished then
begin
log(mtDebug, self,'Destroy terminated '+con.ConnectionID);
log(mtDebug, self,'Закрытие по таймауту '+con.ConnectionID);
con.free;
conlist.delete(i);
end;
@ -215,7 +216,7 @@ var
cmd: TCommand;
begin
try
log(mtInfo, Self,'Process Request '+ACommand);
log(mtDebug, Self,'Обработка запроса '+ACommand);
ClearTerminated;
result := false;
RetValue := 0;
@ -356,11 +357,9 @@ begin
begin
if cmd.Status=StatusComplete then
begin
log(mtDebug,self,'result ready');
cmd.Results.AssignTo(Code,RetValue,Answer,rValues,iValues,ByteData);
cmd.Done;
result := true;
log(mtDebug,self,'result ready ok ');
end
else
begin
@ -378,7 +377,7 @@ begin
result := false;
Answer := e.message;
Code := ErrorInternal;
log(mtError,self,format('ProcessRequest () -> %s(%s)',[e.ClassName,e.Message]));
LogError(self,e, format('ProcessRequest(%s)',[ACommand]));
end;
end;
@ -394,6 +393,7 @@ procedure TConnectionsDM.FillTemplates(RepList: TStrings);
var
asql: string;
begin
try
asql :=
'select r.xp_rpt_id,r.name, c.cgi_name from xp_report r '+
' join xp_report_cgi c on c.xp_rpt_id=r.xp_rpt_id '+
@ -408,6 +408,13 @@ begin
finally
free;
end;
except on e: Exception do
begin
logError(Self,e,format('FillTemplates',[]));
raise;
end;
end;
end;
function TConnectionsDM.CalcHash(Data: TStream): string;
var
@ -455,7 +462,15 @@ function TConnectionsDM.ProcessLogin(UserName, UserPassword: string; out UserID
var
ASQL: string;
begin
try
Result := MainCon.CheckUser(UserName,UserPassword,UserID);
except on e: Exception do
begin
logError(Self,e,format('ProcessLogin(user=%s)',[UserName]));
raise;
end;
end;
end;
function TConnectionsDM.ProcessArguments(ReportName: string; out
@ -465,6 +480,7 @@ var
begin
result := false;
rValues := TStringList.Create;
try
ASQL := format(
'select r.xp_rpt_id,r.name as reportname,p.name as paramname, '+
'case p.type '+
@ -508,12 +524,20 @@ begin
free;
end;
except on e: Exception do
begin
logError(Self,e,format('ProcessArguments(report=%s)',[ReportName]));
raise;
end;
end;
end;
function TConnectionsDM.ProcessReports(out rValues: TStrings): boolean;
var
ASQL: string;
begin
try
rValues := TStringList.Create;
ASQL :=
'select c.cgi_name,r.name as rep_name '+
@ -531,6 +555,13 @@ begin
finally
free;
end;
except on e: Exception do
begin
LogError(self,e,format('ProcessReports',[]));
raise;
end;
end;
result := true;
end;
@ -542,6 +573,7 @@ var
code: string;
i: integer;
begin
try
ASQL := format(
'select source from xp_report_params p '+
' join xp_report_cgi c on c.xp_rpt_id=p.xp_rpt_id '+
@ -570,6 +602,13 @@ begin
free;
end;
result := true;
except on e: Exception do
begin
LogError(self,e,format('ProcessOptionValues(report=%s,param=%s)',[ReportName,ParamName]));
raise;
end;
end;
end;
@ -586,10 +625,10 @@ begin
fDataBase:= ini.ReadString('DATA','database','');
fServicePort := ini.ReadInteger('PARAMS','port',6543);
fTimeOut:=ini.ReadInteger('PARAMS','timeout',CONNECT_TIMEOUT);
log(mtInfo,self,format('server %s:%d/%s',[fDataHost,fDataPort,fDataBase]));
finally
ini.free;
end;
log(mtInfo,self,format('База данных %s:%d/%s Порт для соединения %d',[fDataHost,fDataPort,fDataBase,fServicePort]));
end;
procedure TConnectionsDM.Log(ALevel: TLogLevel; Sender: TObject; msg: string);
@ -617,6 +656,12 @@ begin
end;
end;
procedure TConnectionsDM.LogError(Sender: TObject; e: Exception; Command: string
);
begin
log(mtError,Sender,format('%s вызвала ошибку %s(%s) ',[Command, e.classname,e.message]));
end;
procedure TConnectionsDM.InitBaseCon;
begin
MainCon.connection.RemoteHost:=DataHost;

2
exttypes.pas
View File

@ -7,7 +7,7 @@ interface
uses
Classes, SysUtils, LNet, syncobjs;
const
version='0.0.0.1';
version='0.0.1.2';
cmdRequest=1;
cmdAnswer=2;
cmdError=3;

4
reportdmunit.lfm
View File

@ -5,11 +5,11 @@ object ReportDM: TReportDM
VerticalOffset = 317
Width = 330
object frxReport: TfrxReport
Version = '2023.3.3'
Version = '2023.3.0'
DotMatrixReport = False
EngineOptions.SilentMode = True
EngineOptions.NewSilentMode = simSilent
IniFile = '\Software\Fast Reports'
IniFile = 'tmp/fr6.ini'
PreviewOptions.Buttons = [pbPrint, pbLoad, pbSave, pbExport, pbZoom, pbFind, pbOutline, pbPageSetup, pbTools, pbEdit, pbNavigator, pbExportQuick, pbCopy, pbSelection]
PreviewOptions.Zoom = 1
PrintOptions.Printer = 'Default'

18
reportdmunit.pas
View File

@ -194,7 +194,6 @@ end;
procedure TReportDM.frxReportEndDoc(Sender: TObject);
begin
NidbData.log(mtDebug,Sender,'TReportDM.frxReportEndDoc');;
end;
procedure TReportDM.CreateDBDataSet(Query: TReportQuery; EditReport: Boolean);
@ -364,7 +363,6 @@ procedure TReportDM.frxReportPreview(Sender: TObject);
var
Report: TfrxReport;
begin
NidbData.log(mtDebug,Sender,'TReportDM.frxReportPreview');;
inherited;
end;
@ -374,7 +372,6 @@ var
q: TReportquery;
i: integer;
begin
NidbData.log(mtDebug,self,'LoadQueries');
SQL := format(
'select q.xp_rpt_q_id,qp.xp_rpt_q_id as ParentID,q.Link_field, '+
' q.Name,'+
@ -405,12 +402,10 @@ begin
for i := ReportQueries.QueryCount-1 downto 0 do
if ReportQueries.Queries[i].ParentID>0 then
begin
NidbData.log(mtDebug,self,'LoadQueries.'+ReportQueries.Queries[i].Name);
q := ReportQueries.Find(ReportQueries.Queries[i].ParentID);
if assigned(q) then
q.AddQuery(ReportQueries.Queries[i]);
end;
NidbData.log(mtDebug,self,'LoadQueries-OK');
end;
procedure TReportDM.LoadDefaultVariables(AVariables: TxpMemParamManager);
@ -421,7 +416,6 @@ var
OptionName,
OptionValue: String;
begin
NidbData.log(mtDebug,self,'LoadDefaultVariables');
SQL := 'select name,value from options where name in (''GOU_Name'',''Dep_Name'')';
with NidbData.GetData(sql) do
@ -490,7 +484,6 @@ procedure TReportDM.LoadVariables(AVariables, AParam: TxpMemParamManager);
var
sql: string;
begin
NidbData.log(mtDebug,self,'LoadVariables');
sql := 'select name,value_string, value_int from tmp_report_variables where var_type=0';
with NidbData.GetData(sql) do
try
@ -525,7 +518,6 @@ begin
//
//
NidbData.log(mtDebug,self,'LoadVariables-OK');
end;
procedure TReportDM.OnMasterRecord(Sender: TObject);
@ -570,7 +562,6 @@ var
BlobStream : TStream;
begin
NidbData.log(mtDebug,self,'ExportReport.TemplateArh');
ReportStream := TMemoryStream.Create;
try
with NidbData.GetData(format('select TemplateArh from xp_report where xp_rpt_id=%d',[RecordID])) do
@ -614,7 +605,6 @@ var
ASQL: string;
newhash: string;
begin
NidbData.log(mtDebug,self,'ExportReport.TemplateArh');
ReportStream := TMemoryStream.Create;
BlobStream := TMemoryStream.Create;
try
@ -637,7 +627,6 @@ var
i: integer;
v: variant;
begin
NidbData.log(mtDebug,self,'CopyReportVariables');
for I := Low(AVariables.Params) to High(AVariables.Params) do
begin
if VarIsStr(AVariables.Params[i][1]) then
@ -659,7 +648,6 @@ end;
procedure TReportDM.LogExport(Sender: TObject);
begin
NidbData.log(mtDebug,Sender,'export-started');
end;
@ -675,7 +663,6 @@ var
begin
fOnVars:=OnVars;
frxReport.EngineOptions.EnableThreadSafe:=true;
NidbData.log(mtDebug,self,'ExportReport');
ReportQueries := TReportQuery.Create;
AVariables := TxpMemParamManager.Create;
AParam := TxpMemParamManager.Create;
@ -706,7 +693,7 @@ begin
try
frxReport.PrepareReport(False);
frxReport.OnPreview := @frxReportPreview;
frxReport.SaveToFile(Extractfilepath(paramstr(0))+'out/report.fr3');
{$IFDEF DEBUG} frxReport.SaveToFile(Extractfilepath(paramstr(0))+'out/report.fr3'); {$ENDIF}
except on e: Exception do
begin
NidbData.logError(self,e,'frxReport.PrepareReport');
@ -751,7 +738,6 @@ begin
AVariables.Free;
AParam.Free;
end;
NidbData.log(mtDebug,self,'Report complete');
end;
procedure TReportDM.EditReport(OnVars: TVariableFillProc; OnHash: TCalcHashProc
@ -765,7 +751,6 @@ var
begin
fOnVars:=OnVars;
frxReport.EngineOptions.EnableThreadSafe:=true;
NidbData.log(mtDebug,self,'EditReport');
ReportQueries := TReportQuery.Create;
AVariables := TxpMemParamManager.Create;
AParam := TxpMemParamManager.Create;
@ -798,7 +783,6 @@ begin
AVariables.Free;
AParam.Free;
end;
NidbData.log(mtDebug,self,'Report complete');
end;