LMSTWO-1

baseconnection.pas

@@ -56,7 +56,7 @@ type
 
   TBaseConnection=class(TThread)
     private
-    fOwner:TObject;
+    fOwner:TComponent;
     fLogger: TLogger;
     fConnectionID: string;
     fTimeout: integer;
@@ -88,12 +88,12 @@ type
     property CountCompleted: integer read nCommandComplete;
     property CountReady: integer read nCommandReady;
     property CountErrors: integer read nErrors;
-    property Owner: TObject read fOwner;
+    property Owner: TComponent read fOwner;
     property ConnectionID: string read fConnectionID;
     property Processor: TNIDBDM read fProcessor;
     property ReportProcessor: TReportDM read fReportProcessor;
     procedure Init;
-    constructor Create(AOwner: TObject;ATimeOut: integer; aLogger: TLogger);
+    constructor Create(AOwner: TComponent;ATimeOut: integer; aLogger: TLogger);
     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;
@@ -104,12 +104,17 @@ type
     procedure Execute; override;
     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;
   end;
 
 implementation
 uses
-  commandcol;
+  commandcol,ConnectionsDmUnit;
 { TBaseConnection }
+function TBaseConnection.calchash(data: TStream): string;
+begin
+  result := (Owner as TConnectionsDM).CalcHash(data);
+end;
 
 procedure TBaseConnection.Init;
 begin
@@ -120,7 +125,7 @@ begin
 end;
 
 
-constructor TBaseConnection.Create(AOwner: TObject; ATimeOut: integer;
+constructor TBaseConnection.Create(AOwner: TComponent; ATimeOut: integer;
   aLogger: TLogger);
 begin
   inherited Create(true);
@@ -129,7 +134,7 @@ begin
   flogger := ALogger;
   fProcessor:=TNIDBDM.Create(nil);
   fProcessor.logger:=aLogger;
-  fReportProcessor:=TReportDM.Create(nil);
+  fReportProcessor:=TReportDM.Create(AOwner);
   fReportProcessor.NidbData := fProcessor;
   Commands:=TStringList.Create;
   DoneCommands:=TList.Create;

cgidm.lfm

@@ -2,10 +2,10 @@ object NIDBDM: TNIDBDM
   OnCreate = DataModuleCreate
   OnDestroy = DataModuleDestroy
   OldCreateOrder = False
-  Height = 150
+  Height = 281
   HorizontalOffset = 417
   VerticalOffset = 131
-  Width = 150
+  Width = 315
   object nnzQuery1: TnnzQuery
     FieldDefs = <>
     ReadOnly = True
@@ -13,26 +13,4 @@ object NIDBDM: TNIDBDM
     Left = 25
     Top = 36
   end
-  object frxReport1: TfrxReport
-    Version = '2023.1'
-    DotMatrixReport = False
-    IniFile = '\Software\Fast Reports'
-    PreviewOptions.Buttons = [pbPrint, pbLoad, pbSave, pbExport, pbZoom, pbFind, pbOutline, pbPageSetup, pbTools, pbEdit, pbNavigator, pbExportQuick, pbCopy, pbSelection]
-    PreviewOptions.Zoom = 1
-    PrintOptions.Printer = 'Default'
-    PrintOptions.PrintOnSheet = 0
-    ReportOptions.CreateDate = 45099.7272582292
-    ReportOptions.LastChange = 45099.7272582292
-    ScriptLanguage = 'PascalScript'
-    ScriptText.Strings = (
-      'begin'
-      ''
-      'end.'
-    )
-    Left = 64
-    Top = 92
-    Datasets = <>
-    Variables = <>
-    Style = <>
-  end
 end

cgidm.pas

@@ -12,7 +12,6 @@ type
   { TNIDBDM }
 
   TNIDBDM = class(TDataModule)
-    frxReport1: TfrxReport;
     nnzQuery1: TnnzQuery;
     procedure DataModuleCreate(Sender: TObject);
     procedure DataModuleDestroy(Sender: TObject);
@@ -240,7 +239,7 @@ begin
       s := Arguments.Names[i];
       v := Arguments.Values[s];
       Code := StringReplace(Code,'{s#'+s+'}',  TNidbDM.StringAsSQL(v),[rfReplaceAll]);
-      Code := StringReplace(Code,'{d#'+s+'}',TNidbDM.StringAsSQL(v),[rfReplaceAll]);
+      Code := StringReplace(Code,'{d#'+s+'}',TNidbDM.StringAsSQL(v)+'::date',[rfReplaceAll]);
       Code := StringReplace(Code,'{#'+s+'}',v,[rfReplaceAll]);
     end;
 end;

cgireport.pas

@@ -366,7 +366,7 @@ begin
   end;
   fcurrentStage := 'исполняется ()';
   try
-  connect.ReportProcessor.EditReport(@OnFillVariables);
+  connect.ReportProcessor.EditReport(@OnFillVariables,@connect.calchash);
   except on e: Exception do
     begin
       connect.Processor.LogError(self,e,'ExportReport');

commandcol.pas

@@ -24,6 +24,8 @@ implementation
 
 class procedure TCommandCollection.Register(ACommand: TCommandClass);
 begin
+  if not assigned(fCollection) then
+    Init;
   fCollection.Add(ACommand);
 end;
 
@@ -48,6 +50,7 @@ end;
 
 class procedure TCommandCollection.Init;
 begin
+  if not assigned(fCollection) then
     fCollection := TCommandCollection.Create;
 end;
 

connectionsdmunit.pas

@@ -36,7 +36,8 @@ type
     fRunning: boolean;
      function getConnection(ID: string): TBaseConnection;
     function NewConnection: TBaseConnection;
-    procedure Remove(ID: string);
+    procedure Remove(con: TBaseConnection); overload;
+    procedure Remove(ID: string); overload;
     procedure ClearConnections;
     procedure ClearTerminated;
     procedure ConnectNew(aSocket: TLSocket);
@@ -63,6 +64,7 @@ type
     constructor CreateWithLog(ALogger: TEventLog);
     procedure FillTemplates(RepList: TStrings);
     procedure EditTemplate(ReportID: integer);
+    function CalcHash(Data: TStream): string;
   end;
 
 var
@@ -133,6 +135,20 @@ begin
 
 end;
 
+procedure TConnectionsDM.Remove(con: TBaseConnection);
+var
+  i: integer;
+begin
+
+  for i := conList.Count-1 downto 0 do
+    if TBaseConnection(conlist[i])=con then
+      begin
+        log(mtDebug,self,'terminate '+con.ConnectionID);
+        TBaseConnection(conlist[i]).terminate;
+        exit;
+      end;
+end;
+
 procedure TConnectionsDM.Remove(ID: string);
 var
   i: integer;
@@ -377,6 +393,25 @@ begin
        free;
     end;
 end;
+function TConnectionsDM.CalcHash(Data: TStream): string;
+var
+  Digest: packed array[0..19] of byte;
+  i,l: integer;
+  b: array[0..$100000-1] of byte;
+begin
+  Result := '';
+  Hash.Init;
+  Data.Seek(0,soFromBeginning);
+  repeat
+     l := Data.Read(b,sizeof(b));
+     Hash.Update(b,l);
+  until l=0;
+  Data.Seek(0,soFromBeginning);
+  Hash.Final(Digest);
+  Hash.Burn;
+  for i:= 0 to 19 do
+    Result := Result + AnsiString(IntToHex(Digest[i], 2));
+end;
 
 procedure TConnectionsDM.EditTemplate(ReportID: integer);
 var
@@ -401,7 +436,7 @@ begin
         cmd.free;
      end;
   finally
-     con.Free;
+     con.terminate;
   end;
 end;
 

reportdmunit.pas

@@ -14,7 +14,7 @@ type
   TReportQuery=class;
 
   TVariableFillProc=procedure(AVariables: TxpMemParamManager) of object;
-
+  TCalcHashProc=function(Data: TStream): string of object;
   TReportQuery=class
     private
       fQueries: TList;
@@ -80,14 +80,14 @@ type
     procedure LoadLogos(AVariables : TxpMemParamManager);
     procedure LoadVariables(AVariables, AParam : TxpMemParamManager);
     procedure OnMasterRecord(Sender: TObject);
-    procedure LoadReportTemplate();
+    function LoadReportTemplate(OnHash: TCalcHashProc): string;
-    procedure SaveReportTemplate();
+    procedure SaveReportTemplate(hash: string;OnHash: TCalcHashProc);
     procedure CopyReportVariables(AVariables, AParam: TxpMemParamManager);
   public
     RecordID: integer;
     NidbData: TNIDBDM;
     procedure ExportReport( ExportType: TExportFileType; Data: TStream; OnStage: TLogger; OnVars: TVariableFillProc);
-    procedure EditReport(OnVars: TVariableFillProc);
+    procedure EditReport(OnVars: TVariableFillProc; OnHash: TCalcHashProc);
   end;
 
 var
@@ -558,7 +558,7 @@ begin
  end;
 end;
 
-procedure TReportDM.LoadReportTemplate;
+function TReportDM.LoadReportTemplate(OnHash: TCalcHashProc): string;
 var
   ReportStream : TMemoryStream;
   BlobStream   : TStream;
@@ -583,6 +583,10 @@ begin
       begin
         ReportStream.Position := 0;
         try
+          if assigned(OnHash) then
+            result := onHash(ReportStream)
+          else
+            result := '';
         frxReport.LoadFromStream(ReportStream);
 
         except on e: Exception do
@@ -597,17 +601,20 @@ begin
     end;  // try
 end;
 
-procedure TReportDM.SaveReportTemplate;
+procedure TReportDM.SaveReportTemplate(hash: string; OnHash: TCalcHashProc);
 var
   ReportStream : TMemoryStream;
   BlobStream   : TStream;
   ASQL: string;
+  newhash: string;
 begin
   NidbData.log(mtDebug,self,'ExportReport.TemplateArh');
   ReportStream := TMemoryStream.Create;
   BlobStream := TMemoryStream.Create;
     try
       frxReport.SaveToStream(ReportStream);
+      newhash := onHash(ReportStream);
+      if newhash=hash then exit;
       ReportStream.seek(0,soFromBeginning);
       PackReport(ReportStream,BlobStream,AbZipper1);
       ASQL := format('update xp_report set TemplateArh=%s where xp_rpt_id=%d',[TNIDBDM.StreamAsSQL(BlobStream),RecordID]);
@@ -653,6 +660,7 @@ var
   flt          : TfrxCustomExportFilter;
   v            : Variant;
   AVariables, AParam: TxpMemParamManager;
+  oldHash: string;
 begin
  fOnVars:=OnVars;
  frxReport.EngineOptions.EnableThreadSafe:=true;
@@ -677,7 +685,7 @@ begin
     if assigned(OnStage) then
       OnStage(mtExtra,self,'загрузка шаблона');
 
-    LoadReportTemplate;
+    oldHash := LoadReportTemplate(nil);
     CopyReportVariables(AVariables,AParam);
     TxpFRFunctions.SetReport(NidbData,AVariables);
     if assigned(OnStage) then
@@ -730,12 +738,14 @@ begin
   NidbData.log(mtDebug,self,'Report complete');
 end;
 
-procedure TReportDM.EditReport(OnVars: TVariableFillProc);
+procedure TReportDM.EditReport(OnVars: TVariableFillProc; OnHash: TCalcHashProc
+  );
 var
   I            : Integer;
   flt          : TfrxCustomExportFilter;
   v            : Variant;
   AVariables, AParam: TxpMemParamManager;
+  oldHash: string;
 begin
  fOnVars:=OnVars;
  frxReport.EngineOptions.EnableThreadSafe:=true;
@@ -752,14 +762,13 @@ begin
     frxReport.EngineOptions.DestroyForms := False;
     // Создаём источники данных
     CreateDBDataSet(ReportQueries);
-    LoadReportTemplate;
+    oldHash:=LoadReportTemplate(onHash);
     CopyReportVariables(AVariables,AParam);
     TxpFRFunctions.SetReport(NidbData,AVariables);
 
     try
       frxReport.DesignReport;
-      if frxReport.Modified then
+      SaveReportTemplate(oldHash,onHash);
-        SaveReportTemplate();
     except on e: Exception do
       begin
       NidbData.logError(self,e,'frxReport.PrepareReport');

xpReportUtil.pas

@@ -37,7 +37,7 @@ var
   i: integer;
   tmp: TStream;
 begin
-  if SrcStream.Size > 0 then
+  if assigned(SrcStream) and (SrcStream.Size > 0) then
   begin
     tmp := TMemoryStream.Create;
     rptCode := TStringList.Create;