alexey.zablotskiy/LMS-2_ReportAPI
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

LMSTWO-1

Browse Source
This commit is contained in:
Алексей Заблоцкий 2023-11-07 20:52:31 +03:00
parent 93dcd6fdfd
commit 885d006de3
8 changed files with 77 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
baseconnection.pas
View File

@ -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;

26
cgidm.lfm
View File

@ -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

3
cgidm.pas
View File

@ -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;

2
cgireport.pas
View File

@ -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');

3
commandcol.pas
View File

@ -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;

39
connectionsdmunit.pas
View File

@ -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;

31
reportdmunit.pas
View File

@ -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');

2
xpReportUtil.pas
View File

@ -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;