diff --git a/baseconnection.pas b/baseconnection.pas index d3c05f5..a2557d5 100644 --- a/baseconnection.pas +++ b/baseconnection.pas @@ -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; diff --git a/cgi_daemon.pas b/cgi_daemon.pas index 2b54a2f..231a862 100644 --- a/cgi_daemon.pas +++ b/cgi_daemon.pas @@ -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; diff --git a/cgireport.pas b/cgireport.pas index 45e1c29..3e1c6f8 100644 --- a/cgireport.pas +++ b/cgireport.pas @@ -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 diff --git a/commandcol.pas b/commandcol.pas index 2d8875d..2d2bf46 100644 --- a/commandcol.pas +++ b/commandcol.pas @@ -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 diff --git a/commit_info.sh b/commit_info.sh old mode 100644 new mode 100755 diff --git a/connectionsdmunit.pas b/connectionsdmunit.pas index 0b1aec7..f0fd2bf 100644 --- a/connectionsdmunit.pas +++ b/connectionsdmunit.pas @@ -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; diff --git a/exttypes.pas b/exttypes.pas index fd672d9..5eed2ea 100644 --- a/exttypes.pas +++ b/exttypes.pas @@ -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; diff --git a/reportdmunit.lfm b/reportdmunit.lfm index 5cc7539..d726dc9 100644 --- a/reportdmunit.lfm +++ b/reportdmunit.lfm @@ -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' diff --git a/reportdmunit.pas b/reportdmunit.pas index 3790d5b..c22b205 100644 --- a/reportdmunit.pas +++ b/reportdmunit.pas @@ -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;