frxzip.pas

这个是功能强大的报表软件

{******************************************}
{                                          }
{             FastReport v4.0              }
{         ZIP archiver support unit        }
{                                          }
{         Copyright (c) 2006-2008          }
{          by Alexander Fediachov,         }
{             Fast Reports Inc.            }
{                                          }
{******************************************}

unit frxZip;

{$I frx.inc}

interface

uses Classes, Windows, frxZLib, frxGZip, frxUtils, frxFileUtils;

type
  TfrxZipLocalFileHeader = class;
  TfrxZipCentralDirectory = class;
  TfrxZipFileHeader = class;

  TfrxZipArchive = class(TObject)
  private
    FRootFolder: AnsiString;
    FErrors: TStringList;
    FFileList: TStringList;
    FComment: AnsiString;
    FProgress: TNotifyEvent;
    function GetCount: Integer;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    procedure AddFile(const FileName: AnsiString);
    procedure AddDir(const DirName: AnsiString);
    procedure SaveToStream(const Stream: TStream);
    procedure SaveToFile(const Filename: AnsiString);
    property RootFolder: AnsiString read FRootFolder write FRootFolder;
    property Errors: TStringList read FErrors;
    property Comment: AnsiString read FComment write FComment;
    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;
    FExtraField: AnsiString;
    FFileName: AnsiString;
    FFileNameLength: WORD;
    FExtraFieldLength: WORD;
    procedure SetExtraField(const Value: AnsiString);
    procedure SetFileName(const Value: AnsiString);
  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;
    property FileName: AnsiString read FFileName write SetFileName;
    property ExtraField: AnsiString read FExtraField write SetExtraField;
  end;

  TfrxZipCentralDirectory = class(TObject)
  private
    FEndOfChentralDirSignature: Longword;
    FNumberOfTheDisk: WORD;
    FTotalOfEntriesCentralDirOnDisk: WORD;
    FNumberOfTheDiskStartCentralDir: WORD;
    FTotalOfEntriesCentralDir: WORD;
    FSizeOfCentralDir: Longword;
    FOffsetStartingDiskDir: Longword;
    FComment: AnsiString;
    FCommentLength: WORD;
    procedure SetComment(const Value: AnsiString);
  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;
    property Comment: AnsiString read FComment write SetComment;
  end;

  TfrxZipFileHeader = class(TObject)
  private
    FCentralFileHeaderSignature: Longword;
    FRelativeOffsetLocalHeader: Longword;
    FUnCompressedSize: Longword;
    FCompressedSize: Longword;
    FCrc32: Longword;
    FExternalFileAttribute: Longword;
    FExtraField: AnsiString;
    FFileComment: AnsiString;
    FFileName: AnsiString;
    FCompressionMethod: WORD;
    FDiskNumberStart: WORD;
    FLastModFileDate: WORD;
    FLastModFileTime: WORD;
    FVersionMadeBy: WORD;
    FGeneralPurpose: WORD;
    FFileNameLength: WORD;
    FInternalFileAttribute: WORD;
    FExtraFieldLength: WORD;
    FVersionNeeded: WORD;
    FFileCommentLength: WORD;
    procedure SetExtraField(const Value: AnsiString);
    procedure SetFileComment(const Value: AnsiString);
    procedure SetFileName(const Value: AnsiString);
  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;
    property FileName: AnsiString read FFileName write SetFileName;
    property ExtraField: AnsiString read FExtraField write SetExtraField;
    property FileComment: AnsiString read FFileComment write SetFileComment;
  end;

  TfrxZipLocalFile = class(TObject)
  private
    FLoacalFileHeader: TfrxZipLocalFileHeader;
    FFileData: TMemoryStream;
    FOffset: Longword;
  public
    constructor Create;
    destructor Destroy; override;
    procedure SaveToStream(const Stream: TStream);
    property LocalFileHeader: TfrxZipLocalFileHeader read FLoacalFileHeader;
    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
  FLoacalFileHeader := TfrxZipLocalFileHeader.Create;
  FOffset := 0;
end;

destructor TfrxZipLocalFile.Destroy;
begin
  FLoacalFileHeader.Free;
  inherited;
end;

procedure TfrxZipLocalFile.SaveToStream(const Stream: TStream);
begin
  FLoacalFileHeader.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: AnsiString);
begin
  FExtraField := Value;
  FExtraFieldLength := Length(Value);
end;

procedure TfrxZipLocalFileHeader.SetFileName(const Value: AnsiString);
begin
  FFileName :=  StringReplace(Value, AnsiString('\'), AnsiString('/'), [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;