LMS2.6

baseconnection.pas

@@ -30,6 +30,7 @@ type
     nErrors: integer;
     fCheckConnect: boolean;
     procedure CleanDone;
+    function getCommand(index: integer): TCommand;
     public
     Host: string;
     port: integer;
@@ -57,6 +58,7 @@ type
     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 RunCommand(ACommand: TCommand): boolean;
     function FindCommand(IDCommand: string): TCommand;
+    function CommandCount: integer;
     procedure Idle;
     procedure SetIdle;
     procedure Execute; override;
@@ -64,6 +66,7 @@ type
     class function newID: string;
     function calchash(data: TStream): string;
     property Journal: TStrings read fJournal;
+    property AllCommands[index: integer]: TCommand read getCommand;
   end;
 
 implementation
@@ -219,6 +222,11 @@ begin
   result := nil;
 end;
 
+function TBaseConnection.CommandCount: integer;
+begin
+ result := Commands.Count;
+end;
+
 procedure TBaseConnection.Idle;
 var
   d: TDateTime;
@@ -258,6 +266,11 @@ begin
     end;
 end;
 
+function TBaseConnection.getCommand(index: integer): TCommand;
+begin
+  result := (Commands.Objects[index] as TCommand);
+end;
+
 procedure TBaseConnection.Log(ALevel: TLogLevel; sender: TObject; msg: string);
 begin
   case ALevel of

connectionsdmunit.pas

@@ -259,9 +259,9 @@ begin
     begin
       result := true;
       rValues := TStringList.Create;
-      rvalues.Add('"help"');
+      rvalues.Add('{action:"help",params:[]}');
-      rvalues.Add('"version"');
+      rvalues.Add('{action:"version",params:[]}');
-      rValues.add('"reports"');
+      rValues.add('{action:"reports",params:[]}');
       rValues.add('{action:"arguments",params:["report"]}');
       rValues.add('{action:"login",params:["user","password"]}');
       rValues.add('{action:"logout",params:["connect"]}');
@@ -269,7 +269,7 @@ begin
       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"]}');
+      rValues.add('{action:"status",params:["connect","operation?"]}');
       rValues.add('{action:"result",params:["connect","operation"]}');
     end;
   if ACommand='version' then
@@ -368,32 +368,62 @@ begin
 
   if (ACommand='status') or (ACommand='result') then
     begin
-  cmdID := fields.Values['operation'];
+      cmdID := fields.Values['operation'];
-  cmd := con.FindCommand(cmdID);
+      cmd := con.FindCommand(cmdID);
-  if not assigned(cmd) then
+      if (ACommand='result') and (cmdID='') then
-    begin
-      Answer := 'command not found';
-      Code := ErrorCommand;
-      exit;
-    end;
-  if ACommand='status' then
-    begin
-      Answer := cmd.currentStage;
-      if assigned(cmd.Results) then
-        cmd.Results.AssignTo(Code,RetValue,Answer,rValues)
-      else
         begin
-          rValues := TSTringList.Create;
+          Answer := 'operation not specified';
-          for i := 0 to cmd.Journal.count-1 do
+          Code := ErrorCommand;
-            rValues.add('"'+TNIDBDM.StringAsJSON(cmd.Journal[i])+'"');
+          exit;
         end;
-      code := cmd.Status;
+      if (ACommand='result') and not assigned(cmd) then
-      if (code=StatusComplete) and assigned(cmd.Results.Data) then
+        begin
-        RetValue:=cmd.Results.Data.Size
+          Answer := 'operation not found '+cmdID;
-      else
+          Code := ErrorCommand;
-        RetValue := 0;
+          exit;
-      result := true;
+        end;
-      exit;
+      if (cmdID<>'') and not assigned(cmd) then
+        begin
+          Answer := 'operation not found '+cmdID;
+          Code := ErrorCommand;
+          exit;
+        end;
+      if ACommand='status' then
+        begin
+          if not assigned(cmd) then
+            begin
+              RetValue:=con.CommandCount;
+              rValues := TStringList.Create;
+              {action:"help",params:[]}
+              rValues.Add('operations:[');
+              for i := 0 to RetValue-1 do
+                begin
+                  cmd := con.AllCommands[i];
+                  Answer := cmd.currentStage;
+                  code := cmd.Status;
+                  rValues.Add(format('{id:"%s",name:"%s",status:%d,stage:"%s"},',[NIDBDM.StringAsJSON(cmd.CommandID),NIDBDM.StringAsJSON(cmd.CommandName),cmd.Status, NIDBDM.StringAsJSON(cmd.CurrentStage)]));
+                end;
+              rValues.Add('{id:"",name:"",status:-1,stage:""}]');
+            end
+          else
+            begin
+              Answer := cmd.currentStage;
+              if assigned(cmd.Results) then
+                cmd.Results.AssignTo(Code,RetValue,Answer,rValues)
+              else
+                begin
+                  rValues := TSTringList.Create;
+                  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
+                RetValue:=cmd.Results.Data.Size
+              else
+                RetValue := 0;
+            end;
+          result := true;
+          exit;
     end;
   if ACommand='result' then
     begin

reportdmunit.lfm

@@ -5,7 +5,7 @@ object ReportDM: TReportDM
   VerticalOffset = 317
   Width = 330
   object frxReport: TfrxReport
-    Version = '2023.3.3'
+    Version = '2024.1.0'
     DotMatrixReport = False
     EngineOptions.SilentMode = True
     EngineOptions.NewSilentMode = simSilent

reportdmunit.pas

@@ -85,7 +85,7 @@ type
     procedure OnMasterRecord(Sender: TObject);
     function LoadReportTemplate(OnHash: TCalcHashProc): string;
     procedure SaveReportTemplate(hash: string;OnHash: TCalcHashProc);
-    procedure CopyReportVariables(AVariables, AParam: TxpMemParamManager);
+    procedure CopyReportVariables(AVariables, AParam: TxpMemParamManager; OnStage: TLogger);
     procedure LogExport(Sender: TObject);
   public
     RecordID: integer;
@@ -620,12 +620,15 @@ begin
 end;
 
 
-procedure TReportDM.CopyReportVariables(AVariables, AParam: TxpMemParamManager);
+procedure TReportDM.CopyReportVariables(AVariables, AParam: TxpMemParamManager;
+  OnStage: TLogger);
 var
   i: integer;
   v: variant;
 begin
-  for I := Low(AVariables.Params) to High(AVariables.Params) do
+  if assigned(OnStage) then
+    OnStage(mtDebug,self,'Переменные отчета');
+   for I := Low(AVariables.Params) to High(AVariables.Params) do
       begin
       if VarIsStr(AVariables.Params[i][1]) then
         v := maskFRSpecial(VarToStr(AVariables.Params[i][1]))
@@ -682,7 +685,7 @@ begin
       OnStage(mtExtra,self,'загрузка шаблона');
 
     oldHash := LoadReportTemplate(nil);
-    CopyReportVariables(AVariables,AParam);
+    CopyReportVariables(AVariables,AParam, OnStage);
     TxpFRFunctions.SetReport(NidbData,AVariables);
     if assigned(OnStage) then
       OnStage(mtExtra,self,'формирование отчета');
@@ -707,7 +710,7 @@ begin
       end;
       flt.OnBeforeExport:=@LogExport;
       flt.OnBeginExport:=@LogExport;
-
+      flt.OpenAfterExport:=false;
       try
         if assigned(OnStage) then
           OnStage(mtExtra,self,'выгрузка');
@@ -718,11 +721,14 @@ begin
         flt.ShowProgress := false;
         try
         if not frxReport.Export(flt) then
+          begin
           NidbData.log(mtWarning,self,'ERROR EXPORT PDF');
-
+          OnStage(mtError,self,'Ошибка выгрузки в PDF');
+          end;
          except on e: Exception do
             begin
             NidbData.logError(self,e,'frxReport.Export');
+            OnStage(mtError,self,'Ошибка выгрузки в PDF '+e.message);
             raise;
             end;
           end;
@@ -762,7 +768,7 @@ begin
     // Создаём источники данных
     CreateDBDataSet(ReportQueries);
     oldHash:=LoadReportTemplate(onHash);
-    CopyReportVariables(AVariables,AParam);
+    CopyReportVariables(AVariables,AParam,nil);
     TxpFRFunctions.SetReport(NidbData,AVariables);
 
     try