📄 kazip.pas
字号:
unit KAZip;
interface
{DEFINE USE_BZIP2}
uses
Windows,
SysUtils,
Classes,
Masks,
{$IFDEF USE_BZIP2}
BZip2,
{$ENDIF}
ZLib;
type
TKAZipEntries = class;
TKAZip = class;
TBytes = Array of Byte;
TOnDecompressFile=Procedure(Sender:TObject; Current, Total : Integer) of Object;
TOnCompressFile=Procedure(Sender:TObject; Current, Total : Integer) of Object;
TOnZipChange=Procedure(Sender:TObject; ChangeType : Integer) of Object;
TZipSaveMethod = (FastSave, RebuildAll);
TZipCompressionType = (ctNormal, ctMaximum, ctFast, ctSuperFast, ctNone, ctUnknown);
TZipCompressionMethod = (cmStored, cmShrunk, cmReduced1, cmReduced2, cmReduced3, cmReduced4, cmImploded, cmTokenizingReserved, cmDeflated, cmDeflated64, cmDCLImploding, cmPKWAREReserved);
{
0 - The file is stored (no compression)
1 - The file is Shrunk
2 - The file is Reduced with compression factor 1
3 - The file is Reduced with compression factor 2
4 - The file is Reduced with compression factor 3
5 - The file is Reduced with compression factor 4
6 - The file is Imploded
7 - Reserved for Tokenizing compression algorithm
8 - The file is Deflated
9 - Enhanced Deflating using Deflate64(tm)
10 - PKWARE Data Compression Library Imploding
11 - Reserved by PKWARE
12 - File is compressed using BZIP2 algorithm
}
TZLibStreamHeader = packed record
CMF : Byte;
FLG : Byte;
end;
TLocalFile = packed record
LocalFileHeaderSignature : Cardinal; // 4 bytes (0x04034b50)
VersionNeededToExtract : WORD; // 2 bytes
GeneralPurposeBitFlag : WORD; // 2 bytes
CompressionMethod : WORD; // 2 bytes
LastModFileTimeDate : Cardinal; // 4 bytes
Crc32 : Cardinal; // 4 bytes
CompressedSize : Cardinal; // 4 bytes
UncompressedSize : Cardinal; // 4 bytes
FilenameLength : WORD; // 2 bytes
ExtraFieldLength : WORD; // 2 bytes
FileName : AnsiString; // variable size
ExtraField : AnsiString; // variable size
CompressedData : AnsiString; // variable size
end;
TDataDescriptor = packed record
Crc32 : Cardinal; // 4 bytes
CompressedSize : Cardinal; // 4 bytes
UncompressedSize : Cardinal; // 4 bytes
End;
TCentralDirectoryFile = packed record
CentralFileHeaderSignature : Cardinal; // 4 bytes (0x02014b50)
VersionMadeBy : WORD; // 2 bytes
VersionNeededToExtract : WORD; // 2 bytes
GeneralPurposeBitFlag : WORD; // 2 bytes
CompressionMethod : WORD; // 2 bytes
LastModFileTimeDate : Cardinal; // 4 bytes
Crc32 : Cardinal; // 4 bytes
CompressedSize : Cardinal; // 4 bytes
UncompressedSize : Cardinal; // 4 bytes
FilenameLength : WORD; // 2 bytes
ExtraFieldLength : WORD; // 2 bytes
FileCommentLength : WORD; // 2 bytes
DiskNumberStart : WORD; // 2 bytes
InternalFileAttributes : WORD; // 2 bytes
ExternalFileAttributes : Cardinal; // 4 bytes
RelativeOffsetOfLocalHeader : Cardinal; // 4 bytes
FileName : AnsiString; // variable size
ExtraField : AnsiString; // variable size
FileComment : AnsiString; // variable size
end;
TEndOfCentralDir = packed record
EndOfCentralDirSignature : Cardinal; // 4 bytes (0x06054b50)
NumberOfThisDisk : WORD; // 2 bytes
NumberOfTheDiskWithTheStart : WORD; // 2 bytes
TotalNumberOfEntriesOnThisDisk : WORD; // 2 bytes
TotalNumberOfEntries : WORD; // 2 bytes
SizeOfTheCentralDirectory : Cardinal; // 4 bytes
OffsetOfStartOfCentralDirectory : Cardinal; // 4 bytes
ZipfileCommentLength : WORD; // 2 bytes
end;
TKAZipEntriesEntry = Class(TCollectionItem)
private
{ Private declarations }
FParent : TKAZipEntries;
FCentralDirectoryFile : TCentralDirectoryFile;
FLocalFile : TLocalFile;
FIsEncrypted : Boolean;
FIsFolder : Boolean;
FDate : TDateTime;
FCompressionType : TZipCompressionType;
FSelected : Boolean;
procedure SetSelected(const Value: Boolean);
function GetLocalEntrySize: Cardinal;
function GetCentralEntrySize: Cardinal;
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
Function GetCompressedData : String;Overload;
Function GetCompressedData(Stream : TStream) : Integer;Overload;
procedure ExtractToFile(FileName: String);
procedure ExtractToStream(Stream: TStream);
procedure SaveToFile(FileName: String);
procedure SaveToStream(Stream: TStream);
Function Test:Boolean;
Property FileName : String Read FCentralDirectoryFile.FileName;
Property Comment : String Read FCentralDirectoryFile.FileComment;
Property SizeUncompressed : Cardinal Read FCentralDirectoryFile.UncompressedSize;
Property SizeCompressed : Cardinal Read FCentralDirectoryFile.CompressedSize;
Property Date : TDateTime Read FDate;
Property CRC32 : Cardinal Read FCentralDirectoryFile.CRC32;
Property Attributes : Cardinal Read FCentralDirectoryFile.ExternalFileAttributes;
Property LocalOffset : Cardinal Read FCentralDirectoryFile.RelativeOffsetOfLocalHeader;
Property IsEncrypted : Boolean Read FIsEncrypted;
Property IsFolder : Boolean Read FIsFolder;
Property BitFlag : Word Read FCentralDirectoryFile.GeneralPurposeBitFlag;
Property CompressionMethod : Word Read FCentralDirectoryFile.CompressionMethod;
Property CompressionType : TZipCompressionType Read FCompressionType;
Property LocalEntrySize : Cardinal Read GetLocalEntrySize;
Property CentralEntrySize : Cardinal Read GetCentralEntrySize;
Property Selected : Boolean Read FSelected Write SetSelected;
End;
TKAZipEntries = class(TCollection)
private
{ Private declarations }
FParent : TKAZip;
FIsZipFile : Boolean;
function GetHeaderEntry(Index: Integer): TKAZipEntriesEntry;
procedure SetHeaderEntry(Index: Integer; const Value: TKAZipEntriesEntry);
protected
{ Protected declarations }
Function ReadBA(MS: TStream;Sz,Poz:Integer): TBytes;
function Adler32(adler : uLong; buf : pByte; len : uInt) : uLong;
function CalcCRC32(const UncompressedData : string): Cardinal;
function CalculateCRCFromStream(var Stream: TFileStream): Cardinal;
Function RemoveRootName(FileName, RootName : String):String;
Procedure SortList(List : TList);
function FileTime2DateTime(FileTime: TFileTime): TDateTime;
//**************************************************************************
Function FindCentralDirectory(MS:TStream):Boolean;
function ParseCentralHeaders(MS: TStream): Boolean;
function GetLocalEntry(MS: TStream; Offset : Integer; HeaderOnly : Boolean): TLocalFile;
Procedure LoadLocalHeaders(MS: TStream);
Function ParseLocalHeaders(MS:TStream):Boolean;
//**************************************************************************
Function AddStreamFast(ItemName:String; FileAttr : Word; FileDate : TDateTime; Stream:TStream):TKAZipEntriesEntry;Overload;
Function AddStreamRebuild(ItemName:String; FileAttr : Word; FileDate : TDateTime; Stream:TStream):TKAZipEntriesEntry;
//**************************************************************************
public
{ Public declarations }
Procedure ParseZip(MS:TStream);
Constructor Create(AOwner : TKAZip; MS : TStream);Overload;
Constructor Create(AOwner : TKAZip);Overload;
Destructor Destroy; Override;
//**************************************************************************
Function IndexOf(Const FileName:String):Integer;
//**************************************************************************
Function AddFile(FileName, NewFileName: String):TKAZipEntriesEntry;Overload;
Function AddFile(FileName:String):TKAZipEntriesEntry;Overload;
Function AddFiles(FileNames:TStrings):Boolean;
Function AddFolder(FolderName:String; RootFolder:String; WildCard:String; WithSubFolders : Boolean):Boolean;
Function AddFilesAndFolders(FileNames:TStrings; RootFolder:String; WithSubFolders : Boolean):Boolean;
Function AddStream(FileName:String; FileAttr : Word; FileDate : TDateTime; Stream:TStream):TKAZipEntriesEntry;Overload;
Function AddStream(FileName: String; Stream : TStream):TKAZipEntriesEntry;Overload;
//**************************************************************************
Procedure Remove(ItemIndex:Integer);Overload;
Procedure Remove(Item:TKAZipEntriesEntry);Overload;
Procedure Remove(FileName:String);Overload;
Procedure RemoveFiles(List : TList);
Procedure RemoveSelected;
//**************************************************************************
Procedure Select(WildCard : String);
Procedure SelectAll;
Procedure DeSelectAll;
Procedure InvertSelection;
//**************************************************************************
procedure ExtractToFile (Item : TKAZipEntriesEntry; FileName: String);Overload;
procedure ExtractToFile (ItemIndex : Integer; FileName: String);Overload;
procedure ExtractToFile (FileName, DestinationFileName:String);Overload;
procedure ExtractToStream(Item : TKAZipEntriesEntry; Stream: TStream);
procedure ExtractAll(TargetDirectory:String);
procedure ExtractSelected(TargetDirectory:String);
//**************************************************************************
Property Items[Index : Integer] : TKAZipEntriesEntry read GetHeaderEntry write SetHeaderEntry;
end;
TKAZip = class(TComponent)
private
{ Private declarations }
FZipHeader : TKAZipEntries;
FEndOfCentralDirPos : Cardinal;
FEndOfCentralDir : TEndOfCentralDir;
FZipCommentPos : Cardinal;
FZipComment : TStringList;
FRebuildECDP : Cardinal;
FRebuildCP : Cardinal;
FIsZipFile : Boolean;
FFileName : String;
FFileNames : TStringList;
FZipSaveMethod : TZipSaveMethod;
FExternalStream : Boolean;
FStoreRelativePath : Boolean;
FZipCompressionType : TZipCompressionType;
FCurrentDFS : Cardinal;
FOnDecompressFile : TOnDecompressFile;
FOnCompressFile : TOnCompressFile;
FOnZipChange : TOnZipChange;
FBatchMode : Boolean;
NewLHOffsets : Array of Cardinal;
NewEndOfCentralDir : TEndOfCentralDir;
procedure SetFileName(const Value: String);
procedure SetIsZipFile(const Value: Boolean);
function GetComment: TStrings;
procedure SetComment(const Value: TStrings);
procedure SetZipSaveMethod(const Value: TZipSaveMethod);
procedure SetActive(const Value: Boolean);
procedure SetZipCompressionType(const Value: TZipCompressionType);
function GetFileNames: TStrings;
procedure SetFileNames(const Value: TStrings);
protected
{ Protected declarations }
FZipStream : TStream;
//**************************************************************************
Procedure LoadFromFile(FileName:String);
Procedure LoadFromStream(MS : TStream);
//**************************************************************************
Procedure RebuildLocalFiles(MS : TStream);
Procedure RebuildCentralDirectory(MS : TStream);
Procedure RebuildEndOfCentralDirectory(MS : TStream);
//**************************************************************************
procedure OnDecompress(Sender:TObject);
procedure OnCompress(Sender:TObject);
Procedure DoChange(Sender:TObject; ChangeType : Integer);Virtual;
//**************************************************************************
public
{ Public declarations }
Constructor Create(AOwner:TComponent);Override;
Destructor Destroy; Override;
//**************************************************************************
function GetDelphiTempFileName: String;
function GetFileName(S: String): String;
function GetFilePath(S: String): String;
//**************************************************************************
Procedure CreateZip(Stream:TStream);Overload;
Procedure CreateZip(FileName:String);Overload;
Procedure Open(FileName:String);Overload;
Procedure Open(MS : TStream);Overload;
Procedure SaveToStream(Stream:TStream);
Procedure Close;
//**************************************************************************
Function AddFile(FileName, NewFileName: String):TKAZipEntriesEntry;Overload;
Function AddFile(FileName:String):TKAZipEntriesEntry;Overload;
Function AddFiles(FileNames:TStrings):Boolean;
Function AddFolder(FolderName:String; RootFolder:String; WildCard:String; WithSubFolders : Boolean):Boolean;
Function AddFilesAndFolders(FileNames:TStrings; RootFolder:String; WithSubFolders : Boolean):Boolean;
Function AddStream(FileName:String; FileAttr : Word; FileDate : TDateTime; Stream:TStream):TKAZipEntriesEntry;Overload;
Function AddStream(FileName: String; Stream : TStream):TKAZipEntriesEntry;Overload;
//**************************************************************************
Procedure Remove(ItemIndex:Integer);Overload;
Procedure Remove(Item:TKAZipEntriesEntry);Overload;
Procedure Remove(FileName:String);Overload;
Procedure RemoveFiles(List : TList);
Procedure RemoveSelected;
//**************************************************************************
Procedure Select(WildCard : String);
Procedure SelectAll;
Procedure DeSelectAll;
Procedure InvertSelection;
//**************************************************************************
procedure ExtractToFile (Item : TKAZipEntriesEntry; FileName: String);Overload;
procedure ExtractToFile (ItemIndex : Integer; FileName: String);Overload;
procedure ExtractToFile (FileName, DestinationFileName:String);Overload;
procedure ExtractToStream(Item : TKAZipEntriesEntry; Stream: TStream);
procedure ExtractAll(TargetDirectory: String);
procedure ExtractSelected(TargetDirectory: String);
//**************************************************************************
Property Entries : TKAZipEntries Read FZipHeader;
published
{ Published declarations }
Property FileName : String Read FFileName Write SetFileName;
Property IsZipFile : Boolean Read FIsZipFile Write SetIsZipFile;
Property SaveMethod : TZipSaveMethod Read FZipSaveMethod Write SetZipSaveMethod;
Property StoreRelativePath : Boolean Read FStoreRelativePath Write FStoreRelativePath;
Property CompressionType : TZipCompressionType Read FZipCompressionType Write SetZipCompressionType;
Property Comment : TStrings Read GetComment Write SetComment;
Property FileNames : TStrings Read GetFileNames Write SetFileNames;
Property OnDecompressFile : TOnDecompressFile Read FOnDecompressFile Write FOnDecompressFile;
Property OnCompressFile : TOnCompressFile Read FOnCompressFile Write FOnCompressFile;
Property OnZipChange : TOnZipChange Read FOnZipChange Write FOnZipChange;
Property Active : Boolean Read FIsZipFile Write SetActive;
end;
procedure Register;
Function ToZipName(FileName:String):String;
Function ToDosName(FileName:String):String;
implementation
Const
ZL_DEF_COMPRESSIONMETHOD = $8; { Deflate }
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -