128 lines
3.5 KiB
ObjectPascal
128 lines
3.5 KiB
ObjectPascal
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.
|