This commit is contained in:
Алексей Заблоцкий 2023-11-16 22:22:59 +03:00
parent 6488e9c8b4
commit ae186d4934
7 changed files with 88 additions and 19 deletions

View File

@ -55,6 +55,8 @@ begin
self.Logger.AppendContent:=true; self.Logger.AppendContent:=true;
self.Logger.LogType := ltFile; self.Logger.LogType := ltFile;
self.Logger.FileName := format('%s/server.log',[extractfilepath(paramstr(0))]); self.Logger.FileName := format('%s/server.log',[extractfilepath(paramstr(0))]);
{$ELSE}
self.Logger.LogType := ltSystem;
{$ENDIF} {$ENDIF}
self.logger.Identification:='LMS-Report-Service'; self.logger.Identification:='LMS-Report-Service';
self.Logger.Active:=true; self.Logger.Active:=true;

View File

@ -64,6 +64,7 @@ end;
procedure TReportCommand.SetStage(ALevel: TLogLevel; Sender: TObject; procedure TReportCommand.SetStage(ALevel: TLogLevel; Sender: TObject;
stageName: string); stageName: string);
begin begin
log(mtInfo,stageName);
fcurrentStage:=format('выполняется (%s)',[stageName]); fcurrentStage:=format('выполняется (%s)',[stageName]);
end; end;
@ -245,6 +246,8 @@ begin
end; end;
fResult := TCommandData.Create(0,fileData.size,ReportTitle+'.pdf',['type=application/pdf'],[],fileData); fResult := TCommandData.Create(0,fileData.size,ReportTitle+'.pdf',['type=application/pdf'],[],fileData);
fileData.Seek(0,soFromBeginning); fileData.Seek(0,soFromBeginning);
(fileData as TMemoryStream).SaveToFile(Extractfilepath(paramstr(0))+'out/report.pdf');
fileData.Seek(0,soFromBeginning);
result := true; result := true;
finally finally
fileData.Free; fileData.Free;

View File

@ -185,6 +185,7 @@ var
i: integer; i: integer;
con: TBaseConnection; con: TBaseConnection;
begin begin
log(mtDebug,self,'ClearTerminated');
for i := conlist.Count-1 downto 0 do for i := conlist.Count-1 downto 0 do
begin begin
con := TBaseConnection(conlist[i]); con := TBaseConnection(conlist[i]);
@ -224,6 +225,7 @@ begin
setLength(iValues,0); setLength(iValues,0);
if ACommand='stop' then if ACommand='stop' then
begin begin
log(mtDebug,self,'stop');
ClearConnections; ClearConnections;
Input.Terminate; Input.Terminate;
fRunning:=false; fRunning:=false;
@ -354,9 +356,11 @@ begin
begin begin
if cmd.Status=StatusComplete then if cmd.Status=StatusComplete then
begin begin
log(mtDebug,self,'result ready');
cmd.Results.AssignTo(Code,RetValue,Answer,rValues,iValues,ByteData); cmd.Results.AssignTo(Code,RetValue,Answer,rValues,iValues,ByteData);
cmd.Done; cmd.Done;
result := true; result := true;
log(mtDebug,self,'result ready ok ');
end end
else else
begin begin

View File

@ -443,6 +443,7 @@ procedure TCommandData.AssignTo(out ACode: DWORD; out AParam: QWord; out
var var
i: integer; i: integer;
begin begin
ACode := Code; ACode := Code;
AParam := Param; AParam := Param;
AName := Name; AName := Name;

View File

@ -14,8 +14,9 @@
<UseAppBundle Value="False"/> <UseAppBundle Value="False"/>
<ResourceType Value="res"/> <ResourceType Value="res"/>
</General> </General>
<MacroValues Count="1"> <MacroValues Count="2">
<Macro1 Name="LCLWidgetType" Value="nogui"/> <Macro1 Name="LCLWidgetType" Value="nogui"/>
<Macro4 Name="LCLWidgetType" Value="gtk2"/>
</MacroValues> </MacroValues>
<BuildModes> <BuildModes>
<Item Name="Default" Default="True"/> <Item Name="Default" Default="True"/>
@ -48,10 +49,11 @@
</Linking> </Linking>
</CompilerOptions> </CompilerOptions>
</Item> </Item>
<SharedMatrixOptions Count="3"> <SharedMatrixOptions Count="4">
<Item1 ID="700255898348" Modes="Default" Type="IDEMacro" MacroName="LCLWidgetType" Value="nogui"/> <Item1 ID="700255898348" Modes="Default" Type="IDEMacro" MacroName="LCLWidgetType" Value="nogui"/>
<Item2 ID="180994852241" Type="IDEMacro" MacroName="LCLWidgetType" Value="nogui"/> <Item2 ID="180994852241" Type="IDEMacro" MacroName="LCLWidgetType" Value="nogui"/>
<Item3 ID="177903334474" Modes="Release" Type="IDEMacro" MacroName="LCLWidgetType" Value="nogui"/> <Item3 ID="177903334474" Modes="Release" Type="IDEMacro" MacroName="LCLWidgetType" Value="nogui"/>
<Item4 ID="292602196485" Modes="Default" Type="IDEMacro" MacroName="LCLWidgetType" Value="gtk2"/>
</SharedMatrixOptions> </SharedMatrixOptions>
</BuildModes> </BuildModes>
<PublishOptions> <PublishOptions>
@ -147,7 +149,9 @@
<Unit> <Unit>
<Filename Value="reportdmunit.pas"/> <Filename Value="reportdmunit.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ComponentName Value="ReportDM"/>
<HasResources Value="True"/> <HasResources Value="True"/>
<ResourceBaseClass Value="DataModule"/>
<UnitName Value="reportDMUnit"/> <UnitName Value="reportDMUnit"/>
</Unit> </Unit>
<Unit> <Unit>

View File

@ -5,7 +5,7 @@ object ReportDM: TReportDM
VerticalOffset = 317 VerticalOffset = 317
Width = 330 Width = 330
object frxReport: TfrxReport object frxReport: TfrxReport
Version = '2023.1' Version = '2023.3.3'
DotMatrixReport = False DotMatrixReport = False
EngineOptions.SilentMode = True EngineOptions.SilentMode = True
EngineOptions.NewSilentMode = simSilent EngineOptions.NewSilentMode = simSilent
@ -22,6 +22,7 @@ object ReportDM: TReportDM
'' ''
'end.' 'end.'
) )
OnEndDoc = frxReportEndDoc
OnLoadTemplate = frxReportLoadTemplate OnLoadTemplate = frxReportLoadTemplate
OnLoadDetailTemplate = frxReportLoadDetailTemplate OnLoadDetailTemplate = frxReportLoadDetailTemplate
Left = 176 Left = 176
@ -31,10 +32,12 @@ object ReportDM: TReportDM
Style = <> Style = <>
end end
object frxPDFExport1: TfrxPDFExport object frxPDFExport1: TfrxPDFExport
ExportNotPrintable = True
UseFileCache = True UseFileCache = True
ShowProgress = True ShowProgress = True
OverwritePrompt = False OverwritePrompt = False
DataOnly = False DataOnly = False
EmbeddedFonts = True
EmbedFontsIfProtected = False EmbedFontsIfProtected = False
InteractiveFormsFontSubset = 'A-Z,a-z,0-9,#43-#47 ' InteractiveFormsFontSubset = 'A-Z,a-z,0-9,#43-#47 '
OpenAfterExport = False OpenAfterExport = False
@ -97,4 +100,41 @@ object ReportDM: TReportDM
Left = 186 Left = 186
Top = 155 Top = 155
end end
object frxHTMLExport1: TfrxHTMLExport
UseFileCache = True
ShowProgress = True
OverwritePrompt = False
DataOnly = False
OpenAfterExport = False
FixedWidth = True
Background = False
Centered = False
EmptyLines = True
Print = False
PictureType = gpPNG
Outline = False
Left = 252
Top = 27
end
object frxHTML4DivExport1: TfrxHTML4DivExport
UseFileCache = True
ShowProgress = True
OverwritePrompt = False
DataOnly = False
OpenAfterExport = False
MultiPage = False
Formatted = False
PictureFormat = pfPNG
UnifiedPictures = True
Navigation = False
EmbeddedPictures = False
EmbeddedCSS = False
Outline = False
HTML5 = False
AllPictures = False
ExportAnchors = True
PictureTag = 0
Left = 255
Top = 75
end
end end

View File

@ -5,11 +5,12 @@ unit reportDMUnit;
interface interface
uses uses
Classes, SysUtils, frxClass, frxExportPDF, frxExportODF, Classes, SysUtils, frxClass, frxExportPDF, frxExportODF, frxExportHTML,
xpMemParamManagerUnit, AbUnzper, AbZipper, frxDBSet, cgiDM,extTypes; frxExportHTMLDiv, xpMemParamManagerUnit, AbUnzper, AbZipper, frxDBSet, cgiDM,
extTypes;
type type
TExportFileType = (ftPDF,ftRTF,ftXLS);//(ftPDF,ftMail,ftRTF,ftXLS,ftHTML); TExportFileType = (ftPDF,ftRTF,ftXLS,ftHTML);//(ftPDF,ftMail,ftRTF,ftXLS,ftHTML);
{ TReportDM } { TReportDM }
TReportQuery=class; TReportQuery=class;
@ -40,10 +41,13 @@ type
TReportDM = class(TDataModule) TReportDM = class(TDataModule)
AbUnZipper1: TAbUnZipper; AbUnZipper1: TAbUnZipper;
AbZipper1: TAbZipper; AbZipper1: TAbZipper;
frxHTML4DivExport1: TfrxHTML4DivExport;
frxHTMLExport1: TfrxHTMLExport;
frxODSExport1: TfrxODSExport; frxODSExport1: TfrxODSExport;
frxODTExport1: TfrxODTExport; frxODTExport1: TfrxODTExport;
frxPDFExport1: TfrxPDFExport; frxPDFExport1: TfrxPDFExport;
frxReport: TfrxReport; frxReport: TfrxReport;
procedure frxReportEndDoc(Sender: TObject);
function frxReportLoadDetailTemplate(Report: TfrxReport; function frxReportLoadDetailTemplate(Report: TfrxReport;
const TemplateName: String; const AHyperlink: TfrxHyperlink): Boolean; const TemplateName: String; const AHyperlink: TfrxHyperlink): Boolean;
procedure frxReportLoadTemplate(Report: TfrxReport; procedure frxReportLoadTemplate(Report: TfrxReport;
@ -83,6 +87,7 @@ type
function LoadReportTemplate(OnHash: TCalcHashProc): string; function LoadReportTemplate(OnHash: TCalcHashProc): string;
procedure SaveReportTemplate(hash: string;OnHash: TCalcHashProc); procedure SaveReportTemplate(hash: string;OnHash: TCalcHashProc);
procedure CopyReportVariables(AVariables, AParam: TxpMemParamManager); procedure CopyReportVariables(AVariables, AParam: TxpMemParamManager);
procedure LogExport(Sender: TObject);
public public
RecordID: integer; RecordID: integer;
NidbData: TNIDBDM; NidbData: TNIDBDM;
@ -187,6 +192,11 @@ begin
NidbData.log(mtDebug,self,'LoadDetailTemplate '+TemplateName); NidbData.log(mtDebug,self,'LoadDetailTemplate '+TemplateName);
end; end;
procedure TReportDM.frxReportEndDoc(Sender: TObject);
begin
NidbData.log(mtDebug,Sender,'TReportDM.frxReportEndDoc');;
end;
procedure TReportDM.CreateDBDataSet(Query: TReportQuery; EditReport: Boolean); procedure TReportDM.CreateDBDataSet(Query: TReportQuery; EditReport: Boolean);
var var
i: integer; i: integer;
@ -354,13 +364,8 @@ procedure TReportDM.frxReportPreview(Sender: TObject);
var var
Report: TfrxReport; Report: TfrxReport;
begin begin
NidbData.log(mtDebug,Sender,'TReportDM.frxReportPreview');;
inherited; inherited;
try
Report := Sender as TfrxReport;
Report.PreviewForm.BringToFront;
except on e: Exception do
NidbData.log(mtError,self,e.message);
end;
end; end;
procedure TReportDM.LoadQueries; procedure TReportDM.LoadQueries;
@ -652,6 +657,11 @@ begin
end; end;
procedure TReportDM.LogExport(Sender: TObject);
begin
NidbData.log(mtDebug,Sender,'export-started');
end;
procedure TReportDM.ExportReport(ExportType: TExportFileType; Data: TStream; procedure TReportDM.ExportReport(ExportType: TExportFileType; Data: TStream;
@ -696,7 +706,7 @@ begin
try try
frxReport.PrepareReport(False); frxReport.PrepareReport(False);
frxReport.OnPreview := @frxReportPreview; frxReport.OnPreview := @frxReportPreview;
frxReport.SaveToFile(Extractfilepath(paramstr(0))+'out/report.fr3');
except on e: Exception do except on e: Exception do
begin begin
NidbData.logError(self,e,'frxReport.PrepareReport'); NidbData.logError(self,e,'frxReport.PrepareReport');
@ -705,10 +715,14 @@ begin
end; end;
case ExportType of case ExportType of
ftPDF: flt := TfrxPDFExport.Create(self); ftPDF: flt := frxPDFExport1;
ftRTF: flt := TfrxODTExport.Create(self); ftRTF: flt := frxODTExport1;
ftXLS: flt := TfrxODSExport.Create(self); ftXLS: flt := frxODSExport1;
ftHTML: flt := frxHTML4DivExport1;
end; end;
flt.OnBeforeExport:=@LogExport;
flt.OnBeginExport:=@LogExport;
try try
if assigned(OnStage) then if assigned(OnStage) then
OnStage(mtExtra,self,'выгрузка'); OnStage(mtExtra,self,'выгрузка');
@ -718,7 +732,8 @@ begin
flt.FileName:=''; flt.FileName:='';
flt.ShowProgress := false; flt.ShowProgress := false;
try try
frxReport.Export(flt); if not frxReport.Export(flt) then
NidbData.log(mtWarning,self,'ERROR EXPORT PDF');
except on e: Exception do except on e: Exception do
begin begin
@ -727,7 +742,7 @@ begin
end; end;
end; end;
finally finally
flt.Free; //flt.Free;
end; end;
end; end;
//FreeContainer; //FreeContainer;