logs

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
+  cc := TCommandCollection.Find('report',Reportname);
-  try
+  if assigned(cc) then
-    ParseCommand(0,0,ReportName,ParamValues,[],nil,tmp);
+    try
-    if assigned(tmp) then FreeAndNil(tmp);
+      with cc.Create('', self.Processor,ReportName,fLogger,User,UserID) do
-    result := ProcessOptionValues(ParamName,answer,RetValue,OptionValues);
+      try
-  finally
+        ParseCommand(0,0,ReportName,ParamValues,[],nil,tmp);
-    free
+        if assigned(tmp) then FreeAndNil(tmp);
-  end;
+        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;

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;

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

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

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;

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;

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'

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;