794 lines
25 KiB
ObjectPascal
794 lines
25 KiB
ObjectPascal
|
|
{******************************************}
|
|
{ }
|
|
{ FastReport VCL }
|
|
{ ZIP archiver support unit }
|
|
{ }
|
|
{ Copyright (c) 1998-2021 }
|
|
{ by Fast Reports Inc. }
|
|
{ }
|
|
{******************************************}
|
|
|
|
unit frxZip;
|
|
|
|
{$I frx.inc}
|
|
|
|
interface
|
|
|
|
uses Classes,
|
|
{$IFNDEF NONWINFPC}
|
|
Windows,
|
|
{$ELSE}
|
|
{$DEFINE STATIC_EXPORTING_RESULTS}
|
|
LCLType, LCLIntf, LCLProc, Types, FileUtil,
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI16}
|
|
ZLib,
|
|
{$ELSE}
|
|
frxZLib,
|
|
{$ENDIF}
|
|
frxGZip, frxUtils, frxFileUtils;
|
|
|
|
type
|
|
TfrxZipLocalFileHeader = class;
|
|
TfrxZipCentralDirectory = class;
|
|
TfrxZipFileHeader = class;
|
|
|
|
TfrxZipArchive = class(TObject)
|
|
private
|
|
{$IFDEF Delphi12}
|
|
FRootFolder: AnsiString;
|
|
{$ELSE}
|
|
FRootFolder: String;
|
|
{$ENDIF}
|
|
FErrors: TStringList;
|
|
FFileList: TStringList;
|
|
{$IFDEF Delphi12}
|
|
FComment: AnsiString;
|
|
{$ELSE}
|
|
FComment: AnsiString;
|
|
{$ENDIF}
|
|
FProgress: TNotifyEvent;
|
|
function GetCount: Integer;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure Clear;
|
|
{$IFDEF Delphi12}
|
|
procedure AddFile(const FileName: AnsiString);
|
|
procedure AddDir(const DirName: AnsiString);
|
|
procedure SaveToFile(const Filename: AnsiString);
|
|
{$ELSE}
|
|
procedure AddFile(const FileName: String);
|
|
procedure AddDir(const DirName: String);
|
|
procedure SaveToFile(const Filename: String);
|
|
{$ENDIF}
|
|
procedure SaveToStream(const Stream: TStream);
|
|
procedure SaveToStreamFromList(const Stream: TStream; FileStreams: TStrings);
|
|
property Errors: TStringList read FErrors;
|
|
{$IFDEF Delphi12}
|
|
property Comment: AnsiString read FComment write FComment;
|
|
property RootFolder: AnsiString read FRootFolder write FRootFolder;
|
|
{$ELSE}
|
|
property Comment: String read FComment write FComment;
|
|
property RootFolder: String read FRootFolder write FRootFolder;
|
|
{$ENDIF}
|
|
property FileCount: Integer read GetCount;
|
|
property OnProgress: TNotifyEvent read FProgress write FProgress;
|
|
end;
|
|
|
|
TfrxZipLocalFileHeader = class(TObject)
|
|
private
|
|
FLocalFileHeaderSignature: Longword;
|
|
FVersion: WORD;
|
|
FGeneralPurpose: WORD;
|
|
FCompressionMethod: WORD;
|
|
FCrc32: Longword;
|
|
FLastModFileDate: WORD;
|
|
FLastModFileTime: WORD;
|
|
FCompressedSize: Longword;
|
|
FUnCompressedSize: Longword;
|
|
{$IFDEF Delphi12}
|
|
FExtraField: AnsiString;
|
|
FFileName: AnsiString;
|
|
{$ELSE}
|
|
FExtraField: String;
|
|
FFileName: String;
|
|
{$ENDIF}
|
|
FFileNameLength: WORD;
|
|
FExtraFieldLength: WORD;
|
|
{$IFDEF Delphi12}
|
|
procedure SetExtraField(const Value: AnsiString);
|
|
procedure SetFileName(const Value: AnsiString);
|
|
{$ELSE}
|
|
procedure SetExtraField(const Value: String);
|
|
procedure SetFileName(const Value: String);
|
|
{$ENDIF}
|
|
public
|
|
constructor Create;
|
|
procedure SaveToStream(const Stream: TStream);
|
|
property LocalFileHeaderSignature: Longword read FLocalFileHeaderSignature;
|
|
property Version: WORD read FVersion write FVersion;
|
|
property GeneralPurpose: WORD read FGeneralPurpose write FGeneralPurpose;
|
|
property CompressionMethod: WORD read FCompressionMethod write FCompressionMethod;
|
|
property LastModFileTime: WORD read FLastModFileTime write FLastModFileTime;
|
|
property LastModFileDate: WORD read FLastModFileDate write FLastModFileDate;
|
|
property Crc32: Longword read FCrc32 write FCrc32;
|
|
property CompressedSize: Longword read FCompressedSize write FCompressedSize;
|
|
property UnCompressedSize: Longword read FUnCompressedSize write FUnCompressedSize;
|
|
property FileNameLength: WORD read FFileNameLength write FFileNameLength;
|
|
property ExtraFieldLength: WORD read FExtraFieldLength write FExtraFieldLength;
|
|
{$IFDEF Delphi12}
|
|
property FileName: AnsiString read FFileName write SetFileName;
|
|
property ExtraField: AnsiString read FExtraField write SetExtraField;
|
|
{$ELSE}
|
|
property FileName: String read FFileName write SetFileName;
|
|
property ExtraField: String read FExtraField write SetExtraField;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
TfrxZipCentralDirectory = class(TObject)
|
|
private
|
|
FEndOfChentralDirSignature: Longword;
|
|
FNumberOfTheDisk: WORD;
|
|
FTotalOfEntriesCentralDirOnDisk: WORD;
|
|
FNumberOfTheDiskStartCentralDir: WORD;
|
|
FTotalOfEntriesCentralDir: WORD;
|
|
FSizeOfCentralDir: Longword;
|
|
FOffsetStartingDiskDir: Longword;
|
|
{$IFDEF Delphi12}
|
|
FComment: AnsiString;
|
|
{$ELSE}
|
|
FComment: String;
|
|
{$ENDIF}
|
|
FCommentLength: WORD;
|
|
{$IFDEF Delphi12}
|
|
procedure SetComment(const Value: AnsiString);
|
|
{$ELSE}
|
|
procedure SetComment(const Value: String);
|
|
{$ENDIF}
|
|
public
|
|
constructor Create;
|
|
procedure SaveToStream(const Stream: TStream);
|
|
property EndOfChentralDirSignature: Longword read FEndOfChentralDirSignature;
|
|
property NumberOfTheDisk: WORD read FNumberOfTheDisk write FNumberOfTheDisk;
|
|
property NumberOfTheDiskStartCentralDir: WORD
|
|
read FNumberOfTheDiskStartCentralDir write FNumberOfTheDiskStartCentralDir;
|
|
property TotalOfEntriesCentralDirOnDisk: WORD
|
|
read FTotalOfEntriesCentralDirOnDisk write FTotalOfEntriesCentralDirOnDisk;
|
|
property TotalOfEntriesCentralDir: WORD
|
|
read FTotalOfEntriesCentralDir write FTotalOfEntriesCentralDir;
|
|
property SizeOfCentralDir: Longword read FSizeOfCentralDir write FSizeOfCentralDir;
|
|
property OffsetStartingDiskDir: Longword read FOffsetStartingDiskDir write FOffsetStartingDiskDir;
|
|
property CommentLength: WORD read FCommentLength write FCommentLength;
|
|
{$IFDEF Delphi12}
|
|
property Comment: AnsiString read FComment write SetComment;
|
|
{$ELSE}
|
|
property Comment: String read FComment write SetComment;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
TfrxZipFileHeader = class(TObject)
|
|
private
|
|
FCentralFileHeaderSignature: Longword;
|
|
FRelativeOffsetLocalHeader: Longword;
|
|
FUnCompressedSize: Longword;
|
|
FCompressedSize: Longword;
|
|
FCrc32: Longword;
|
|
FExternalFileAttribute: Longword;
|
|
{$IFDEF Delphi12}
|
|
FExtraField: AnsiString;
|
|
FFileComment: AnsiString;
|
|
FFileName: AnsiString;
|
|
{$ELSE}
|
|
FExtraField: String;
|
|
FFileComment: String;
|
|
FFileName: String;
|
|
{$ENDIF}
|
|
FCompressionMethod: WORD;
|
|
FDiskNumberStart: WORD;
|
|
FLastModFileDate: WORD;
|
|
FLastModFileTime: WORD;
|
|
FVersionMadeBy: WORD;
|
|
FGeneralPurpose: WORD;
|
|
FFileNameLength: WORD;
|
|
FInternalFileAttribute: WORD;
|
|
FExtraFieldLength: WORD;
|
|
FVersionNeeded: WORD;
|
|
FFileCommentLength: WORD;
|
|
{$IFDEF Delphi12}
|
|
procedure SetExtraField(const Value: AnsiString);
|
|
procedure SetFileComment(const Value: AnsiString);
|
|
procedure SetFileName(const Value: AnsiString);
|
|
{$ELSE}
|
|
procedure SetExtraField(const Value: String);
|
|
procedure SetFileComment(const Value: String);
|
|
procedure SetFileName(const Value: String);
|
|
{$ENDIF}
|
|
public
|
|
constructor Create;
|
|
procedure SaveToStream(const Stream: TStream);
|
|
property CentralFileHeaderSignature: Longword read FCentralFileHeaderSignature;
|
|
property VersionMadeBy: WORD read FVersionMadeBy;
|
|
property VersionNeeded: WORD read FVersionNeeded;
|
|
property GeneralPurpose: WORD read FGeneralPurpose write FGeneralPurpose;
|
|
property CompressionMethod: WORD read FCompressionMethod write FCompressionMethod;
|
|
property LastModFileTime: WORD read FLastModFileTime write FLastModFileTime;
|
|
property LastModFileDate: WORD read FLastModFileDate write FLastModFileDate;
|
|
property Crc32: Longword read FCrc32 write FCrc32;
|
|
property CompressedSize: Longword read FCompressedSize write FCompressedSize;
|
|
property UnCompressedSize: Longword read FUnCompressedSize write FUnCompressedSize;
|
|
property FileNameLength: WORD read FFileNameLength write FFileNameLength;
|
|
property ExtraFieldLength: WORD read FExtraFieldLength write FExtraFieldLength;
|
|
property FileCommentLength: WORD read FFileCommentLength write FFileCommentLength;
|
|
property DiskNumberStart: WORD read FDiskNumberStart write FDiskNumberStart;
|
|
property InternalFileAttribute: WORD read FInternalFileAttribute write FInternalFileAttribute;
|
|
property ExternalFileAttribute: Longword read FExternalFileAttribute write FExternalFileAttribute;
|
|
property RelativeOffsetLocalHeader: Longword read FRelativeOffsetLocalHeader write FRelativeOffsetLocalHeader;
|
|
{$IFDEF Delphi12}
|
|
property FileName: AnsiString read FFileName write SetFileName;
|
|
property ExtraField: AnsiString read FExtraField write SetExtraField;
|
|
property FileComment: AnsiString read FFileComment write SetFileComment;
|
|
{$ELSE}
|
|
property FileName: String read FFileName write SetFileName;
|
|
property ExtraField: String read FExtraField write SetExtraField;
|
|
property FileComment: String read FFileComment write SetFileComment;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
TfrxZipLocalFile = class(TObject)
|
|
private
|
|
FLocalFileHeader: TfrxZipLocalFileHeader;
|
|
FFileData: TMemoryStream;
|
|
FOffset: Longword;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure SaveToStream(const Stream: TStream);
|
|
property LocalFileHeader: TfrxZipLocalFileHeader read FLocalFileHeader;
|
|
property FileData: TMemoryStream read FFileData write FFileData;
|
|
property Offset: Longword read FOffset write FOffset;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses SysUtils{$IFDEF Delphi12}, AnsiStrings{$ENDIF};
|
|
|
|
const
|
|
ZIP_VERSIONMADEBY = 20;
|
|
ZIP_NONE = 0;
|
|
ZIP_DEFLATED = 8;
|
|
ZIP_MINSIZE = 128;
|
|
|
|
{ TfrxZipLocalFile }
|
|
|
|
constructor TfrxZipLocalFile.Create;
|
|
begin
|
|
FLocalFileHeader := TfrxZipLocalFileHeader.Create;
|
|
FOffset := 0;
|
|
end;
|
|
|
|
destructor TfrxZipLocalFile.Destroy;
|
|
begin
|
|
FLocalFileHeader.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TfrxZipLocalFile.SaveToStream(const Stream: TStream);
|
|
begin
|
|
FLocalFileHeader.SaveToStream(Stream);
|
|
FFileData.Position := 0;
|
|
FFileData.SaveToStream(Stream);
|
|
end;
|
|
|
|
{ TfrxZipLocalFileHeader }
|
|
|
|
constructor TfrxZipLocalFileHeader.Create;
|
|
begin
|
|
inherited;
|
|
FLocalFileHeaderSignature := $04034b50;
|
|
FVersion := ZIP_VERSIONMADEBY;
|
|
FGeneralPurpose := 0;
|
|
FCompressionMethod := ZIP_NONE;
|
|
FCrc32 := 0;
|
|
FLastModFileDate := 0;
|
|
FLastModFileTime := 0;
|
|
FCompressedSize := 0;
|
|
FUnCompressedSize := 0;
|
|
FExtraField := '';
|
|
FFileName := '';
|
|
FFileNameLength := 0;
|
|
FExtraFieldLength := 0;
|
|
end;
|
|
|
|
procedure TfrxZipLocalFileHeader.SaveToStream(const Stream: TStream);
|
|
begin
|
|
Stream.Write(FLocalFileHeaderSignature, 4);
|
|
Stream.Write(FVersion, 2);
|
|
Stream.Write(FGeneralPurpose, 2);
|
|
Stream.Write(FCompressionMethod, 2);
|
|
Stream.Write(FLastModFileTime, 2);
|
|
Stream.Write(FLastModFileDate, 2);
|
|
Stream.Write(FCrc32, 4);
|
|
Stream.Write(FCompressedSize, 4);
|
|
Stream.Write(FUnCompressedSize, 4);
|
|
Stream.Write(FFileNameLength, 2);
|
|
Stream.Write(FExtraFieldLength, 2);
|
|
if FFileNameLength > 0 then
|
|
Stream.Write(FFileName[1], FFileNameLength);
|
|
if FExtraFieldLength > 0 then
|
|
Stream.Write(FExtraField[1], FExtraFieldLength);
|
|
end;
|
|
|
|
procedure TfrxZipLocalFileHeader.SetExtraField(const Value: {$IFDEF Delphi12}AnsiString{$ELSE}String{$ENDIF});
|
|
begin
|
|
FExtraField := Value;
|
|
FExtraFieldLength := Length(Value);
|
|
end;
|
|
|
|
procedure TfrxZipLocalFileHeader.SetFileName(const Value: {$IFDEF Delphi12}AnsiString{$ELSE}String{$ENDIF});
|
|
begin
|
|
FFileName := StringReplace(Value,
|
|
{$IFDEF Delphi12}AnsiString('\'), AnsiString('/'){$ELSE}'\', '/'{$ENDIF}, [rfReplaceAll]);
|
|
FFileNameLength := Length(Value);
|
|
end;
|
|
|
|
{ TfrxZipCentralDirectory }
|
|
|
|
constructor TfrxZipCentralDirectory.Create;
|
|
begin
|
|
inherited;
|
|
FEndOfChentralDirSignature := $06054b50;
|
|
FNumberOfTheDisk := 0;
|
|
FNumberOfTheDiskStartCentralDir := 0;
|
|
FTotalOfEntriesCentralDirOnDisk := 0;
|
|
FTotalOfEntriesCentralDir := 0;
|
|
FSizeOfCentralDir := 0;
|
|
FOffsetStartingDiskDir := 0;
|
|
FCommentLength := 0;
|
|
FComment := '';
|
|
end;
|
|
|
|
procedure TfrxZipCentralDirectory.SaveToStream(const Stream: TStream);
|
|
begin
|
|
Stream.Write(FEndOfChentralDirSignature, 4);
|
|
Stream.Write(FNumberOfTheDisk, 2);
|
|
Stream.Write(FNumberOfTheDiskStartCentralDir, 2);
|
|
Stream.Write(FTotalOfEntriesCentralDirOnDisk, 2);
|
|
Stream.Write(FTotalOfEntriesCentralDir, 2);
|
|
Stream.Write(FSizeOfCentralDir, 4);
|
|
Stream.Write(FOffsetStartingDiskDir, 4);
|
|
Stream.Write(FCommentLength, 2);
|
|
if FCommentLength > 0 then
|
|
Stream.Write(FComment[1], FCommentLength);
|
|
end;
|
|
|
|
procedure TfrxZipCentralDirectory.SetComment(const Value: {$IFDEF Delphi12}AnsiString{$ELSE}String{$ENDIF});
|
|
begin
|
|
FComment := Value;
|
|
FCommentLength := Length(Value);
|
|
end;
|
|
|
|
{ TfrxZipFileHeader }
|
|
|
|
constructor TfrxZipFileHeader.Create;
|
|
begin
|
|
FCentralFileHeaderSignature := $02014b50;
|
|
FRelativeOffsetLocalHeader := 0;
|
|
FUnCompressedSize := 0;
|
|
FCompressedSize := 0;
|
|
FCrc32 := 0;
|
|
FExternalFileAttribute := 0;
|
|
FExtraField := '';
|
|
FFileComment := '';
|
|
FFileName := '';
|
|
FCompressionMethod := 0;
|
|
FDiskNumberStart := 0;
|
|
FLastModFileDate := 0;
|
|
FLastModFileTime := 0;
|
|
FVersionMadeBy := ZIP_VERSIONMADEBY;
|
|
FGeneralPurpose := 0;
|
|
FFileNameLength := 0;
|
|
FInternalFileAttribute := 0;
|
|
FExtraFieldLength := 0;
|
|
FVersionNeeded := ZIP_VERSIONMADEBY;
|
|
FFileCommentLength := 0;
|
|
end;
|
|
|
|
procedure TfrxZipFileHeader.SaveToStream(const Stream: TStream);
|
|
begin
|
|
Stream.Write(FCentralFileHeaderSignature, 4);
|
|
Stream.Write(FVersionMadeBy, 2);
|
|
Stream.Write(FVersionNeeded, 2);
|
|
Stream.Write(FGeneralPurpose, 2);
|
|
Stream.Write(FCompressionMethod, 2);
|
|
Stream.Write(FLastModFileTime, 2);
|
|
Stream.Write(FLastModFileDate, 2);
|
|
Stream.Write(FCrc32, 4);
|
|
Stream.Write(FCompressedSize, 4);
|
|
Stream.Write(FUnCompressedSize, 4);
|
|
Stream.Write(FFileNameLength, 2);
|
|
Stream.Write(FExtraFieldLength, 2);
|
|
Stream.Write(FFileCommentLength, 2);
|
|
Stream.Write(FDiskNumberStart, 2);
|
|
Stream.Write(FInternalFileAttribute, 2);
|
|
Stream.Write(FExternalFileAttribute, 4);
|
|
Stream.Write(FRelativeOffsetLocalHeader, 4);
|
|
Stream.Write(FFilename[1], FFileNameLength);
|
|
Stream.Write(FExtraField[1], FExtraFieldLength);
|
|
Stream.Write(FFileComment[1], FFileCommentLength);
|
|
end;
|
|
|
|
procedure TfrxZipFileHeader.SetExtraField(const Value: {$IFDEF Delphi12}AnsiString{$ELSE}String{$ENDIF});
|
|
begin
|
|
FExtraField := Value;
|
|
FExtraFieldLength := Length(Value);
|
|
end;
|
|
|
|
procedure TfrxZipFileHeader.SetFileComment(const Value: {$IFDEF Delphi12}AnsiString{$ELSE}String{$ENDIF});
|
|
begin
|
|
FFileComment := Value;
|
|
FFileNameLength := Length(Value);
|
|
end;
|
|
|
|
procedure TfrxZipFileHeader.SetFileName(const Value: {$IFDEF Delphi12}AnsiString{$ELSE}String{$ENDIF});
|
|
begin
|
|
FFileName := StringReplace(Value,
|
|
{$IFDEF Delphi12}AnsiString('\'), AnsiString('/'){$ELSE}'\', '/'{$ENDIF}, [rfReplaceAll]);
|
|
FFileNameLength := Length(Value);
|
|
end;
|
|
|
|
{ TfrxZipArchive }
|
|
|
|
procedure TfrxZipArchive.AddDir(const DirName: {$IFDEF Delphi12}AnsiString{$ELSE}String{$ENDIF});
|
|
var
|
|
SRec: TSearchRec;
|
|
i: Integer;
|
|
{$IFDEF Delphi12}
|
|
s: AnsiString;
|
|
{$ELSE}
|
|
s: String;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF Delphi12}
|
|
if DirectoryExists(String(DirName)) then
|
|
{$ELSE}
|
|
if DirectoryExists(DirName) then
|
|
{$ENDIF}
|
|
begin
|
|
s := DirName;
|
|
if s[Length(s)] <> PathDelim then
|
|
s := s + PathDelim;
|
|
{$IFDEF Delphi12}
|
|
i := FindFirst(String(s) + '*.*', faDirectory + faArchive, SRec);
|
|
{$ELSE}
|
|
i := FindFirst(s + '*.*', faDirectory + faArchive, SRec);
|
|
{$ENDIF}
|
|
try
|
|
while i = 0 do
|
|
begin
|
|
if (SRec.Name <> '.') and (SRec.Name <> '..') then
|
|
begin
|
|
if (SRec.Attr and faDirectory) = faDirectory then
|
|
{$IFDEF Delphi12}
|
|
AddDir(s + AnsiString(SRec.Name))
|
|
else
|
|
AddFile(s + AnsiString(SRec.Name));
|
|
{$ELSE}
|
|
AddDir(s + SRec.Name)
|
|
else
|
|
AddFile(s + SRec.Name);
|
|
{$ENDIF}
|
|
end;
|
|
i := FindNext(SRec);
|
|
end;
|
|
finally
|
|
FindClose(SRec);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF Delphi12}
|
|
procedure TfrxZipArchive.AddFile(const FileName: AnsiString);
|
|
begin
|
|
if FileExists(String(FileName)) then
|
|
begin
|
|
FFileList.Add(String(FileName));
|
|
if FRootFolder = '' then
|
|
FRootFolder := ExtractFilePath(FileName);
|
|
end
|
|
else
|
|
FErrors.Add('File ' + String(FileName) + ' not found!');
|
|
end;
|
|
{$ELSE}
|
|
procedure TfrxZipArchive.AddFile(const FileName: String);
|
|
begin
|
|
if FileExists(FileName) then
|
|
begin
|
|
FFileList.Add(FileName);
|
|
if FRootFolder = '' then
|
|
FRootFolder := ExtractFilePath(FileName);
|
|
end
|
|
else
|
|
FErrors.Add('File ' + FileName + ' not found!');
|
|
end;
|
|
{$ENDIF}
|
|
procedure TfrxZipArchive.Clear;
|
|
begin
|
|
FErrors.Clear;
|
|
FFileList.Clear;
|
|
FRootFolder := '';
|
|
FComment := '';
|
|
end;
|
|
|
|
constructor TfrxZipArchive.Create;
|
|
begin
|
|
FProgress := nil;
|
|
FErrors := TStringList.Create;
|
|
FFileList := TStringList.Create;
|
|
Clear;
|
|
end;
|
|
|
|
destructor TfrxZipArchive.Destroy;
|
|
begin
|
|
FErrors.Free;
|
|
FFileList.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TfrxZipArchive.GetCount: Integer;
|
|
begin
|
|
Result := FFileList.Count;
|
|
end;
|
|
|
|
procedure TfrxZipArchive.SaveToFile(const FileName: {$IFDEF Delphi12}AnsiString{$ELSE}String{$ENDIF});
|
|
var
|
|
f: TFileStream;
|
|
begin
|
|
{$IFDEF Delphi12}
|
|
f := TFileStream.Create(String(FileName), fmCreate);
|
|
{$ELSE}
|
|
f := TFileStream.Create(FileName, fmCreate);
|
|
{$ENDIF}
|
|
try
|
|
SaveToStream(f);
|
|
finally
|
|
f.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxZipArchive.SaveToStream(const Stream: TStream);
|
|
var
|
|
i: Integer;
|
|
ZipFile: TfrxZipLocalFile;
|
|
ZipFileHeader: TfrxZipFileHeader;
|
|
ZipDir: TfrxZipCentralDirectory;
|
|
FileStream: TFileStream;
|
|
TempStream: TMemoryStream;
|
|
{$IFDEF Delphi12}
|
|
FileName: AnsiString;
|
|
{$ELSE}
|
|
FileName: String;
|
|
{$ENDIF}
|
|
CentralStartPos, CentralEndPos: Longword;
|
|
{$IFNDEF STATIC_EXPORTING_RESULTS}
|
|
LFT, LFT2: TFileTime;
|
|
FDate, FTime: WORD;
|
|
{$ENDIF}
|
|
begin
|
|
for i := 0 to FFileList.Count - 1 do
|
|
begin
|
|
ZipFile := TfrxZipLocalFile.Create;
|
|
ZipFile.FileData := TMemoryStream.Create;
|
|
try
|
|
{$IFDEF Delphi12}
|
|
FileName := StringReplace(AnsiString(FFileList[i]), FRootFolder, AnsiString(''), []);
|
|
{$ELSE}
|
|
FileName := StringReplace(FFileList[i], FRootFolder, '', []);
|
|
{$ENDIF}
|
|
ZipFile.LocalFileHeader.FileName := FileName;
|
|
FileStream := TFileStream.Create(FFileList[i], fmOpenRead + fmShareDenyWrite);
|
|
try
|
|
if FileStream.Size > ZIP_MINSIZE then
|
|
begin
|
|
FileStream.Position := 0;
|
|
TempStream := TMemoryStream.Create;
|
|
try
|
|
frxDeflateStream(FileStream, TempStream);
|
|
TempStream.Position := 2;
|
|
ZipFile.FileData.CopyFrom(TempStream, TempStream.Size - 6);
|
|
finally
|
|
TempStream.Free;
|
|
end;
|
|
ZipFile.LocalFileHeader.CompressionMethod := ZIP_DEFLATED;
|
|
end
|
|
else
|
|
begin
|
|
ZipFile.FileData.CopyFrom(FileStream, 0);
|
|
ZipFile.LocalFileHeader.CompressionMethod := ZIP_NONE;
|
|
end;
|
|
ZipFile.LocalFileHeader.CompressedSize := ZipFile.FileData.Size;
|
|
ZipFile.LocalFileHeader.UnCompressedSize := FileStream.Size;
|
|
TempStream := TMemoryStream.Create;
|
|
try
|
|
TempStream.CopyFrom(FileStream, 0);
|
|
ZipFile.LocalFileHeader.Crc32 := frxStreamCRC32(TempStream);
|
|
finally
|
|
TempStream.Free;
|
|
end;
|
|
ZipFile.Offset := Stream.Position;
|
|
{$IFNDEF STATIC_EXPORTING_RESULTS}
|
|
GetFileTime(FileStream.Handle, @LFT, nil, nil);
|
|
FileTimeToLocalFileTime(LFT, LFT2);
|
|
FileTimeToDosDateTime(LFT2, FDate, FTime);
|
|
|
|
// {$IFNDEF STATIC_EXPORTING_RESULTS}
|
|
ZipFile.LocalFileHeader.LastModFileDate := FDate;
|
|
ZipFile.LocalFileHeader.LastModFileTime := FTime;
|
|
{$ENDIF}
|
|
finally
|
|
FileStream.Free;
|
|
end;
|
|
ZipFile.SaveToStream(Stream);
|
|
if Assigned(FProgress) then
|
|
FProgress(Self);
|
|
finally
|
|
ZipFile.FileData.Free;
|
|
ZipFile.FileData := nil;
|
|
end;
|
|
FFileList.Objects[i] := ZipFile;
|
|
end;
|
|
CentralStartPos := Stream.Position;
|
|
for i := 0 to FFileList.Count - 1 do
|
|
begin
|
|
ZipFile := TfrxZipLocalFile(FFileList.Objects[i]);
|
|
ZipFileHeader := TfrxZipFileHeader.Create;
|
|
try
|
|
ZipFileHeader.CompressionMethod := ZipFile.LocalFileHeader.CompressionMethod;
|
|
ZipFileHeader.LastModFileTime := ZipFile.LocalFileHeader.LastModFileTime;
|
|
ZipFileHeader.LastModFileDate := ZipFile.LocalFileHeader.LastModFileDate;
|
|
ZipFileHeader.GeneralPurpose := ZipFile.LocalFileHeader.GeneralPurpose;
|
|
ZipFileHeader.Crc32 := ZipFile.LocalFileHeader.Crc32;
|
|
ZipFileHeader.CompressedSize := ZipFile.LocalFileHeader.CompressedSize;
|
|
ZipFileHeader.UnCompressedSize := ZipFile.LocalFileHeader.UnCompressedSize;
|
|
ZipFileHeader.RelativeOffsetLocalHeader := ZipFile.Offset;
|
|
ZipFileHeader.FileName := ZipFile.LocalFileHeader.FileName;
|
|
ZipFileHeader.SaveToStream(Stream);
|
|
finally
|
|
ZipFileHeader.Free;
|
|
end;
|
|
ZipFile.Free;
|
|
end;
|
|
CentralEndPos := Stream.Position;
|
|
ZipDir := TfrxZipCentralDirectory.Create;
|
|
try
|
|
ZipDir.TotalOfEntriesCentralDirOnDisk := FFileList.Count;
|
|
ZipDir.TotalOfEntriesCentralDir := FFileList.Count;
|
|
ZipDir.SizeOfCentralDir := CentralEndPos - CentralStartPos;
|
|
ZipDir.OffsetStartingDiskDir := CentralStartPos;
|
|
ZipDir.SaveToStream(Stream);
|
|
finally
|
|
ZipDir.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxZipArchive.SaveToStreamFromList(const Stream: TStream; FileStreams: TStrings);
|
|
var
|
|
i: Integer;
|
|
ZipFile: TfrxZipLocalFile;
|
|
ZipFileHeader: TfrxZipFileHeader;
|
|
ZipDir: TfrxZipCentralDirectory;
|
|
FileStream: TStream;
|
|
TempStream: TMemoryStream;
|
|
{$IFDEF Delphi12}
|
|
FileName: AnsiString;
|
|
{$ELSE}
|
|
FileName: String;
|
|
{$ENDIF}
|
|
CentralStartPos, CentralEndPos: Longword;
|
|
{$IFNDEF STATIC_EXPORTING_RESULTS}
|
|
{LFT, }LFT2: TFileTime;
|
|
st: _SYSTEMTIME;
|
|
FDate, FTime: WORD;
|
|
{$ENDIF}
|
|
begin
|
|
for i := 0 to FileStreams.Count - 1 do
|
|
begin
|
|
ZipFile := TfrxZipLocalFile.Create;
|
|
ZipFile.FileData := TMemoryStream.Create;
|
|
try
|
|
{$IFDEF Delphi12}
|
|
FileName := StringReplace(AnsiString(FileStreams[i]), FRootFolder, AnsiString(''), []);
|
|
{$ELSE}
|
|
FileName := StringReplace(FileStreams[i], FRootFolder, '', []);
|
|
{$ENDIF}
|
|
ZipFile.LocalFileHeader.FileName := FileName;
|
|
FileStream := TStream(FileStreams.Objects[i]);// TFileStream.Create(FFileList[i], fmOpenRead + fmShareDenyWrite);
|
|
try
|
|
if FileStream.Size > ZIP_MINSIZE then
|
|
begin
|
|
FileStream.Position := 0;
|
|
TempStream := TMemoryStream.Create;
|
|
try
|
|
frxDeflateStream(FileStream, TempStream);
|
|
TempStream.Position := 2;
|
|
ZipFile.FileData.CopyFrom(TempStream, TempStream.Size - 6);
|
|
finally
|
|
TempStream.Free;
|
|
end;
|
|
ZipFile.LocalFileHeader.CompressionMethod := ZIP_DEFLATED;
|
|
end
|
|
else
|
|
begin
|
|
ZipFile.FileData.CopyFrom(FileStream, 0);
|
|
ZipFile.LocalFileHeader.CompressionMethod := ZIP_NONE;
|
|
end;
|
|
ZipFile.LocalFileHeader.CompressedSize := ZipFile.FileData.Size;
|
|
ZipFile.LocalFileHeader.UnCompressedSize := FileStream.Size;
|
|
TempStream := TMemoryStream.Create;
|
|
try
|
|
TempStream.CopyFrom(FileStream, 0);
|
|
ZipFile.LocalFileHeader.Crc32 := frxStreamCRC32(TempStream);
|
|
finally
|
|
TempStream.Free;
|
|
end;
|
|
ZipFile.Offset := Stream.Position;
|
|
{$IFNDEF STATIC_EXPORTING_RESULTS}
|
|
GetLocalTime(st);
|
|
SystemTimeToFileTime(st, LFT2);
|
|
// GetFileTime(FileStream.Handle, @LFT, nil, nil);
|
|
//FileTimeToLocalFileTime(LFT, LFT2);
|
|
FileTimeToDosDateTime(LFT2, FDate, FTime);
|
|
|
|
|
|
ZipFile.LocalFileHeader.LastModFileDate := FDate;
|
|
ZipFile.LocalFileHeader.LastModFileTime := FTime;
|
|
{$ENDIF}
|
|
finally
|
|
//FileStream.Free;
|
|
end;
|
|
ZipFile.SaveToStream(Stream);
|
|
if Assigned(FProgress) then
|
|
FProgress(Self);
|
|
finally
|
|
ZipFile.FileData.Free;
|
|
ZipFile.FileData := nil;
|
|
end;
|
|
FileStreams.Objects[i] := ZipFile;
|
|
end;
|
|
CentralStartPos := Stream.Position;
|
|
for i := 0 to FileStreams.Count - 1 do
|
|
begin
|
|
ZipFile := TfrxZipLocalFile(FileStreams.Objects[i]);
|
|
ZipFileHeader := TfrxZipFileHeader.Create;
|
|
try
|
|
ZipFileHeader.CompressionMethod := ZipFile.LocalFileHeader.CompressionMethod;
|
|
ZipFileHeader.LastModFileTime := ZipFile.LocalFileHeader.LastModFileTime;
|
|
ZipFileHeader.LastModFileDate := ZipFile.LocalFileHeader.LastModFileDate;
|
|
ZipFileHeader.GeneralPurpose := ZipFile.LocalFileHeader.GeneralPurpose;
|
|
ZipFileHeader.Crc32 := ZipFile.LocalFileHeader.Crc32;
|
|
ZipFileHeader.CompressedSize := ZipFile.LocalFileHeader.CompressedSize;
|
|
ZipFileHeader.UnCompressedSize := ZipFile.LocalFileHeader.UnCompressedSize;
|
|
ZipFileHeader.RelativeOffsetLocalHeader := ZipFile.Offset;
|
|
ZipFileHeader.FileName := ZipFile.LocalFileHeader.FileName;
|
|
ZipFileHeader.SaveToStream(Stream);
|
|
finally
|
|
ZipFileHeader.Free;
|
|
end;
|
|
ZipFile.Free;
|
|
end;
|
|
CentralEndPos := Stream.Position;
|
|
ZipDir := TfrxZipCentralDirectory.Create;
|
|
try
|
|
ZipDir.TotalOfEntriesCentralDirOnDisk := FileStreams.Count;
|
|
ZipDir.TotalOfEntriesCentralDir := FileStreams.Count;
|
|
ZipDir.SizeOfCentralDir := CentralEndPos - CentralStartPos;
|
|
ZipDir.OffsetStartingDiskDir := CentralStartPos;
|
|
ZipDir.SaveToStream(Stream);
|
|
finally
|
|
ZipDir.Free;
|
|
end;
|
|
|
|
end;
|
|
end.
|