unit xpReportUtil; interface uses Classes, AbUnzper,AbZipper; procedure PackReport(SrcStream, DestStream : TStream; Zipper: TAbZipper); procedure UnpackReport(SrcStream, DestStream : TStream; UnZipper: TAbUnZipper); implementation uses zipper,sysutils, ABUtils, LazUTF8; type { TZipTool } TZipTool=class private fSrcStream: TStream; fSrcStrean, fDstStream: TStream; public constructor Create(ASourceStream,ADestStream: TStream); Procedure getSource(Sender: TObject; var AStream: TStream); Procedure getDest(Sender : TObject; var AStream : TStream; AItem : TFullZipFileEntry); Procedure closeSource(Sender: TObject; var AStream: TStream); Procedure doneDest(Sender : TObject; var AStream : TStream; AItem : TFullZipFileEntry); Procedure endFile(Sender : TObject; Const Ratio : Double); Procedure progress(Sender : TObject; Const Pct : Double); property SourceStream: TStream read fSrcStream; property DestStream:TStream read fDstStream; end; procedure UnpackReport(SrcStream, DestStream : TStream; UnZipper: TAbUnZipper); var rptCode: TStringList; i: integer; tmp: TStream; begin if assigned(SrcStream) and (SrcStream.Size > 0) then begin tmp := TMemoryStream.Create; rptCode := TStringList.Create; try UnZipper.Stream := SrcStream; UnZipper.ArchiveType := atZip; UnZipper.ForceType := true; UnZipper.ExtractToStream('Q.Q',tmp); tmp.Seek(0,soFromBeginning); rptCode.LoadFromStream(tmp); // автозамена шрифтов for i := 0 to rptCode.Count-1 do begin {$IFDEF LINUX} rptCode[i] := UTF8StringReplace(rptCode[i],'Font.Name="Times New Roman"','Font.Name="PT Astra Serif"',[]); rptCode[i] := UTF8StringReplace(rptCode[i],'Font.Name="Arial"','Font.Name="Liberation Sans"',[]); rptCode[i] := UTF8StringReplace(rptCode[i],'Rotation="90"','Rotation="90" Wysiwyg="0"',[]); rptCode[i] := UTF8StringReplace(rptCode[i],'Wysiwyg="0" Wysiwyg="0"','Wysiwyg="0"',[]); rptCode[i] := UTF8StringReplace(rptCode[i],'Rotation="90" Wysiwyg="0" Wysiwyg="1"','Rotation="90" Wysiwyg="0"',[]); {$ELSE} rptCode[i] := UTF8StringReplace(rptCode[i],'Font.Name="PT Astra Serif"','Font.Name="Times New Roman"',[]); rptCode[i] := UTF8StringReplace(rptCode[i],'Font.Name="Liberation Sans"','Font.Name="Arial"',[]); {$ENDIF} end; rptCode.SaveToStream(DestStream); finally rptCode.Free; tmp.Free; end; end; // if end; procedure PackReport(SrcStream, DestStream : TStream; Zipper: TAbZipper); begin zipper.FileName := ''; zipper.ArchiveType := atZip; zipper.ForceType := true; zipper.Stream := DestStream; zipper.AddFromStream('Q.Q',SrcStream); zipper.Save; end; { TZipTool } constructor TZipTool.Create(ASourceStream, ADestStream: TStream); begin inherited Create; fSrcStream := ASourceStream; fDstStream := ADestStream; end; procedure TZipTool.getSource(Sender: TObject; var AStream: TStream); begin AStream := fSrcStream; end; procedure TZipTool.getDest(Sender: TObject; var AStream: TStream; AItem: TFullZipFileEntry); begin AStream := fDstStream; end; procedure TZipTool.closeSource(Sender: TObject; var AStream: TStream); begin end; procedure TZipTool.doneDest(Sender: TObject; var AStream: TStream; AItem: TFullZipFileEntry); begin end; procedure TZipTool.endFile(Sender: TObject; const Ratio: Double); begin end; procedure TZipTool.progress(Sender: TObject; const Pct: Double); begin end; end.