From 885d006de37eb68da822c2ec1cb33556d6ed71fc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=D0=90=D0=BB=D0=B5=D0=BA=D1=81=D0=B5=D0=B9=20=D0=97=D0=B0?= =?UTF-8?q?=D0=B1=D0=BB=D0=BE=D1=86=D0=BA=D0=B8=D0=B9?= Date: Tue, 7 Nov 2023 20:52:31 +0300 Subject: [PATCH] LMSTWO-1 --- baseconnection.pas | 17 +++++++++++------ cgidm.lfm | 26 ++------------------------ cgidm.pas | 3 +-- cgireport.pas | 2 +- commandcol.pas | 5 ++++- connectionsdmunit.pas | 39 +++++++++++++++++++++++++++++++++++++-- reportdmunit.pas | 31 ++++++++++++++++++++----------- xpReportUtil.pas | 2 +- 8 files changed, 77 insertions(+), 48 deletions(-) diff --git a/baseconnection.pas b/baseconnection.pas index e5ae355..f6fa2d7 100644 --- a/baseconnection.pas +++ b/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; diff --git a/cgidm.lfm b/cgidm.lfm index adfe6a6..7c77a33 100644 --- a/cgidm.lfm +++ b/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 diff --git a/cgidm.pas b/cgidm.pas index 9371de5..fdbd232 100644 --- a/cgidm.pas +++ b/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; diff --git a/cgireport.pas b/cgireport.pas index efa5341..33a2e13 100644 --- a/cgireport.pas +++ b/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'); diff --git a/commandcol.pas b/commandcol.pas index 6de91ec..f3788e3 100644 --- a/commandcol.pas +++ b/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,7 +50,8 @@ end; class procedure TCommandCollection.Init; begin - fCollection := TCommandCollection.Create; + if not assigned(fCollection) then + fCollection := TCommandCollection.Create; end; class procedure TCommandCollection.Done; diff --git a/connectionsdmunit.pas b/connectionsdmunit.pas index 94da309..e02304b 100644 --- a/connectionsdmunit.pas +++ b/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; diff --git a/reportdmunit.pas b/reportdmunit.pas index 479c806..d812a9d 100644 --- a/reportdmunit.pas +++ b/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(); - procedure SaveReportTemplate(); + function LoadReportTemplate(OnHash: TCalcHashProc): string; + 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(); + SaveReportTemplate(oldHash,onHash); except on e: Exception do begin NidbData.logError(self,e,'frxReport.PrepareReport'); diff --git a/xpReportUtil.pas b/xpReportUtil.pas index 2e97c0e..187e7e4 100644 --- a/xpReportUtil.pas +++ b/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;