📄 vclunzip.pas
字号:
{ ********************************************************************************** }
{ }
{ COPYRIGHT 1997 Kevin Boylan }
{ Source File: VCLUnZip.pas }
{ Description: VCLUnZip component - native Delphi unzip component. }
{ Date: March 1997 }
{ Author: Kevin Boylan, boylank@bigfoot.com }
{ }
{ }
{ ********************************************************************************** }
unit VCLUnZip;
{$P-} { turn off open parameters }
{$R-} { 3/10/98 2.03 }
{$Q-} { 3/10/98 2.03 }
{$B-} { turn off complete boolean eval } { 12/24/98 2.17 }
{$I KPDEFS.INC}
interface
uses
{$IFDEF WIN32}
Windows,
{$ELSE}
WinTypes, WinProcs,
{$ENDIF}
SysUtils, Classes,
{$IFDEF KPSMALL}
kpSmall,
{$ELSE}
Controls, Forms, Dialogs, FileCtrl,
{$ENDIF}
kpCntn, kpMatch, KpLib, kpZipObj{$IFNDEF NO_RES}, kpzcnst{$ENDIF};
const
kpThisVersion = 223; {added this constant 3/1/98 for version 2.03}
{$IFDEF WIN32}
DEF_BUFSTREAMSIZE = 8192; { Changed back to 8192 7/20/01 2.21+ }
{$ELSE} { Larger values can cause memory problems }
DEF_BUFSTREAMSIZE = 8192; { Changed back to 8192 7/20/01 2.21+ }
{$ENDIF}
type
TMultiMode = (mmNone, mmSpan, mmBlocks);
TIncompleteZipMode = (izAssumeMulti, izAssumeBad, izAssumeNotAZip);
TUZOverwriteMode = (Prompt, Always, Never, ifNewer, ifOlder); { added ifNewer,ifOlder 8/2/98 2.14 }
TSkipReason = (srBadPassword, srNoOverwrite, srFileOpenError, srCreateError);
{Decryption}
DecryptKey = array[0..2] of LongInt;
DecryptHeaderPtr = ^DecryptHeaderType;
DecryptHeaderType = array[0..11] of BYTE;
{ Exceptions }
EBadZipFile = class(Exception);
EFileNotAllThere = class(Exception);
EIncompleteZip = class(Exception);
ENotAZipFile = class(Exception);
EFatalUnzipError = class(Exception);
EUserCanceled = class(Exception);
EInvalidPassword = class(Exception);
EBiggerThanUncompressed = class(Exception); { 4/16/98 2.11 }
ENotEnoughRoom = class(Exception);
ECantWriteUCF = class(Exception);
{ Event types }
TStartUnzipInfo = procedure(Sender: TObject; NumFiles: Integer;
TotalBytes: Comp; var StopNow: Boolean) of object;
TStartUnZipEvent = procedure(Sender: TObject; FileIndex: Integer;
var FName: string; var Skip: Boolean) of object;
TEndUnZipEvent = procedure(Sender: TObject; FileIndex: Integer; FName: string) of object;
TFilePercentDone = procedure(Sender: TObject; Percent: LongInt) of object;
TTotalPercentDone = procedure(Sender: TObject; Percent: LongInt) of object;
TPromptForOverwrite = procedure(Sender: TObject; var OverWriteIt: Boolean;
FileIndex: Integer; var FName: string) of object;
TSkippingFile = procedure(Sender: TObject; Reason: TSkipReason; FName: string;
FileIndex: Integer; var Retry: Boolean) of object;
TBadPassword = procedure(Sender: TObject; FileIndex: Integer; var NewPassword: string) of
object;
TBadCRC = procedure(Sender: TObject; CalcCRC, StoredCRC: LongInt;
FileIndex: Integer) of object;
TIncompleteZip = procedure(Sender: TObject; var IncompleteMode: TIncompleteZipMode) of
object;
TGetNextDisk = procedure(Sender: TObject; NextDisk: Integer; var FName: string) of object;
TUnZipComplete = procedure(sender: TObject; FileCount: Integer) of object;
TGetNextBuffer = procedure(Sender: TObject; var Buffer: PChar; FName: string; AmountUsed:
LongInt;
BufferNum: Integer; var Quit: Boolean) of object;
TDecryptEvent = procedure(Sender: TObject; buffer: BytePtr; length: Integer;
Password: String ) of object;
{$IFNDEF WIN32}
DWORD = LongInt;
{$ENDIF}
TVCLUnZip = class(TComponent)
PRIVATE
{ Private declarations }
FZipName: string;
FDestDir: string;
FSortMode: TZipSortMode;
FReCreateDir: Boolean;
FOverwriteMode: TUZOverwriteMode;
FFilesList: TStrings;
FDoAll: Boolean;
FPassword: string;
FIncompleteZipMode: TIncompleteZipMode;
FKeepZipOpen: Boolean;
FDoProcessMessages: Boolean;
FNumDisks: Integer;
FRetainAttributes: Boolean;
FThisVersion: Integer;
FReplaceReadOnly: Boolean;
FNumSelected: Integer;
FBufferLength: LongInt; { 8/23/99 2.18+ }
FImproperZip: Boolean; { 2/19/00 2.20+ }
FEncryptBeforeCompress: Boolean; { 12/9/01 2.22+ }
FOEMConvert: Boolean; { 2/17/02 2.22+ }
{ Event variables }
FOnStartUnzipInfo: TStartUnzipInfo;
FOnStartUnZip: TStartUnZipEvent;
FOnEndUnZip: TEndUnZipEvent;
FOnPromptForOverwrite: TPromptForOverwrite;
FOnBadPassword: TBadPassword;
FOnBadCRC: TBadCRC;
FOnInCompleteZip: TInCompleteZip;
FOnUnzipComplete: TUnZipComplete;
FOnGetNextBuffer: TGetNextBuffer;
FOnDecrypt: TDecryptEvent;
function ProcessIntegrityCheck(Index: Integer): Boolean; { 8/15/99 2.18+ }
{ Decrypt }
PROTECTED
FOnFilePercentDone: TFilePercentDone;
FOnTotalPercentDone: TTotalPercentDone;
FOnSkippingFile: TSkippingFile;
FOnGetNextDisk: TGetNextDisk;
FArchiveStream: TStream;
FBusy: Boolean;
FRootDir: string;
FTestMode: Boolean; { 12/3/98 2.17P+ }
FFlushFilesOnClose: Boolean; { 10/11/99 2.18+ }
FBufferedStreamSize: Integer; { 05/13/00 2.20+ }
ArchiveIsStream: Boolean;
FCheckDiskLabels: Boolean;
FMultiMode: TMultiMode;
file_info: TZipHeaderInfo;
files: TSortedZip;
sortfiles: TSortedZip;
filesDate: TDateTime;
ZipIsBad: Boolean;
CurrentDisk: Integer;
theZipFile: TStream;
Crc32Val: U_LONG;
lrec: local_file_header;
{crec: central_file_header;} { Removed 4/22/02 2.23+ }
ecrec: TEndCentral;
ZipCommentPos: LongInt;
UnZippingSelected: Boolean; { 6/27/99 2.18+ }
tmpMStr: string;
Key: DecryptKey;
CancelOperation: Boolean;
ZipStream: TStream;
StreamZipping: Boolean;
MemZipping: Boolean;
MemBuffer: PChar;
MemLen: LongInt;
MemLeft: LongInt;
CurrMem: PChar;
Fixing: Boolean;
DR: Boolean;
TotalUncompressedSize: Comp;
TotalBytesDone: Comp;
procedure OpenZip;
procedure CloseZip;
function GetCount: Integer;
procedure GetFileInfo(infofile: TStream);
function GetZipName: string;
procedure SetZipName(ZName: string); VIRTUAL;
procedure SetArchiveStream(theStream: TStream);
function GetDestDir: string;
procedure SetDestDir(DDir: string);
procedure SetRootDir(Value: string);
function UnZipFiles(zip_in_file: TStream): Integer;
function UpdCRC(Octet: Byte; Crc: U_LONG): U_LONG;
function SwapDisk(NewDisk: Integer): TStream;
procedure SetFileComment(Index: Integer; theComment: string);
procedure SetZipComment(theComment: string);
procedure WriteNumDisks(NumberOfDisks: Integer);
procedure NewDiskEvent(Sender: TObject; var S: TStream);
procedure SetThisVersion(v: Integer);
function GetCheckDiskLabels: Boolean; VIRTUAL;
procedure SetCheckDiskLabels(Value: Boolean); VIRTUAL;
function CreateNewZipHeader: TZipHeaderInfo;
{ GetMultiMode and SetMultiMode added 3/10/98 for 2.03}
function GetMultiMode: TMultiMode; VIRTUAL;
procedure SetMultiMode(Value: TMultiMode); VIRTUAL;
{ List functions }
procedure SetFilesList(Value: TStrings);
function GetFilename(Index: Integer): TZipFilename;
function GetPathname(Index: Integer): TZipPathname;
function GetFullname(Index: Integer): string;
function GetCompressMethod(Index: Integer): WORD;
function GetCompressMethodStr(Index: Integer): string;
function GetDateTime(Index: Integer): TDateTime;
function GetCrc(Index: Integer): U_LONG;
function GetCompressedSize(Index: Integer): LongInt;
function GetUnCompressedSize(Index: Integer): LongInt;
function GetExternalFileAttributes(Index: Integer): U_LONG;
function GetIsEncrypted(Index: Integer): Boolean;
function GetHasComment(Index: Integer): Boolean;
function GetFileComment(Index: Integer): string;
function GetFileIsOK(Index: Integer): Boolean; { 12/3/98 2.17P+ }
function GetDiskNo(Index: Integer): Integer;
function GetSelected(Index: Integer): Boolean; {6/27/99 2.18+ }
procedure SetSelected(Index: Integer; Value: Boolean);
{$IFDEF ISDELPHI}
function GetDecryptHeader(Index: Integer): DecryptHeaderType;
{$ENDIF}
function GetZipHasComment: Boolean;
function GetZipComment: string;
function GetZipSize: LongInt;
{Decryption}
function DecryptTheHeader(Passwrd: string; zfile: TStream): BYTE;
procedure update_keys(ch: char);
function decrypt_byte: BYTE;
procedure Init_Keys(Passwrd: string);
procedure Update_CRC_buff(bufptr: BYTEPTR; num_to_update: LongInt);
procedure DefaultGetNextDisk(Sender: TObject; NextDisk: Integer; var FName: string);
procedure Loaded; OVERRIDE;
PUBLIC
{ Public declarations }
constructor Create(AOwner: TComponent); OVERRIDE;
destructor Destroy; OVERRIDE;
procedure Assign(Source: TPersistent); OVERRIDE; { 6/27/99 2.18+ }
procedure ReadZip;
function UnZip: Integer;
function UnZipSelected: Integer;
procedure ClearSelected;
procedure ClearZip;
procedure FillList(FilesList: TStrings);
procedure Sort(SMode: TZipSortMode);
procedure CancelTheOperation;
procedure AskForNewDisk(NewDisk: Integer);
function UnZipToStream(theStream: TStream; FName: string): Integer;
function UnZipToStreamByIndex(theStream: TStream; Index: Integer): Integer;
function UnZipToBuffer(var Buffer: PChar; FName: string): Integer;
function UnZipToBufferByIndex(var Buffer: PChar; Index: Integer): Integer;
procedure ResetFileIsOK(Index: Integer);
function CheckArchive: Boolean;
function DecryptHeaderByte(Passwrd: string; dh: DecryptHeaderType): BYTE;
procedure decrypt_buff(bufptr: BYTEPTR; num_to_decrypt: LongInt);
{ The following two are for BCB because of difficulties passing the DecryptHeaderType }
procedure GetDecryptHeaderPtr(Index: Integer; dhPtr: BytePtr); { 8/8/99 2.18+ }
function DecryptHeaderByteByPtr(Passwrd: string; dh: BytePtr): Byte; { 8/8/99 2.18+ }
{ -------- }
property ArchiveStream: TStream READ theZipFile WRITE SetArchiveStream;
property Count: Integer READ GetCount;
property Filename[Index: Integer]: TZipFilename READ GetFilename;
property Pathname[Index: Integer]: TZipPathname READ GetPathname;
property FullName[Index: Integer]: string READ GetFullName;
property CompressMethod[Index: Integer]: WORD READ GetCompressMethod;
property CompressMethodStr[Index: Integer]: string READ GetCompressMethodStr;
property DateTime[Index: Integer]: TDateTime READ GetDateTime;
property Crc[Index: Integer]: U_LONG READ GetCrc;
property CompressedSize[Index: Integer]: LongInt READ GetCompressedSize;
property UnCompressedSize[Index: Integer]: LongInt READ GetUnCompressedSize;
property ExternalFileAttributes[Index: Integer]: U_LONG READ GetExternalFileAttributes;
property IsEncrypted[Index: Integer]: Boolean READ GetIsEncrypted;
property FileHasComment[Index: Integer]: Boolean READ GetHasComment;
property FileComment[Index: Integer]: string READ GetFileComment;
property FileIsOK[Index: Integer]: Boolean READ GetFileIsOK; { 12/3/98 2.17P+ }
property DiskNo[Index: Integer]: Integer READ GetDiskNo;
property Selected[Index: Integer]: Boolean READ GetSelected WRITE SetSelected; { 6/27/99 2.18+ }
property ZipComment: string READ GetZipComment;
property Password: string READ FPassword WRITE FPassword;
property ZipHasComment: Boolean READ GetZipHasComment;
property NumDisks: Integer READ FNumDisks;
property ZipSize: LongInt READ GetZipSize;
property CheckDiskLabels: Boolean READ GetCheckDiskLabels WRITE SetCheckDiskLabels DEFAULT
True;
property MultiMode: TMultiMode READ GetMultiMode WRITE SetMultiMode DEFAULT mmNone;
property Busy: Boolean READ FBusy DEFAULT False;
{$IFDEF ISDELPHI}
property DecryptHeader[Index: Integer]: DecryptHeaderType READ GetDecryptHeader;
{$ENDIF}
property NumSelected: Integer READ FNumSelected;
property BufferLength: LongInt READ FBufferLength WRITE FBufferLength DEFAULT 0;
property ImproperZip: Boolean READ FImproperZip DEFAULT False; { 2/19/00 2.20+ }
property BufferedStreamSize: Integer READ FBufferedStreamSize
WRITE FBufferedStreamSize DEFAULT DEF_BUFSTREAMSIZE;
property EncryptBeforeCompress: Boolean read FEncryptBeforeCompress write FEncryptBeforeCompress
default False;
PUBLISHED
{ Published declarations }
property ThisVersion: Integer READ FThisVersion WRITE SetThisVersion DEFAULT
kpThisVersion;
property ZipName: string READ GetZipName WRITE SetZipName;
property DestDir: string READ GetDestDir WRITE SetDestDir;
property RootDir: string READ FRootDir WRITE SetRootDir;
property SortMode: TZipSortMode READ FSortMode WRITE FSortMode DEFAULT ByNone;
property RecreateDirs: Boolean READ FRecreateDir WRITE FRecreateDir DEFAULT False;
property OverwriteMode: TUZOverwriteMode READ FOverwriteMode
WRITE FOverwriteMode DEFAULT Prompt;
property FilesList: TStrings READ FFilesList WRITE SetFilesList;
property DoAll: Boolean READ FDoAll WRITE FDoAll DEFAULT False;
property IncompleteZipMode: TIncompleteZipMode READ FIncompleteZipMode
WRITE FIncompleteZipMode DEFAULT izAssumeMulti;
property KeepZipOpen: Boolean READ FKeepZipOpen WRITE FKeepZipOpen DEFAULT False;
property DoProcessMessages: Boolean READ FDoProcessMessages WRITE FDoProcessMessages
DEFAULT True;
property RetainAttributes: Boolean READ FRetainAttributes WRITE FRetainAttributes DEFAULT
True;
property ReplaceReadOnly: Boolean READ FReplaceReadOnly WRITE FReplaceReadOnly DEFAULT
False;
property FlushFilesOnClose: Boolean READ FFlushFilesOnClose WRITE FFlushFilesOnClose
DEFAULT False;
{ Event Properties }
property OnStartUnZipInfo: TStartUnzipInfo READ FOnStartUnzipInfo
WRITE FOnStartUnzipInfo;
property OnFilePercentDone: TFilePercentDone READ FOnFilePercentDone
WRITE FOnFilePercentDone;
property OnTotalPercentDone: TTotalPercentDone READ FOnTotalPercentDone
WRITE FOnTotalPercentDone;
property OnStartUnZip: TStartUnZipEvent READ FOnStartUnZip WRITE FOnStartUnZip;
property OnEndUnZip: TEndUnZipEvent READ FOnEndUnZip WRITE FOnEndUnZip;
property OnPromptForOverwrite: TPromptForOverwrite READ FOnPromptForOverwrite
WRITE FOnPromptForOverwrite;
property OnSkippingFile: TSkippingFile READ FOnSkippingFile WRITE FOnSkippingFile;
property OnBadPassword: TBadPassword READ FOnBadPassword WRITE FOnBadPassword;
property OnBadCRC: TBadCRC READ FOnBadCRC WRITE FOnBadCRC;
property OnInCompleteZip: TInCompleteZip READ FOnInCompleteZip WRITE FOnInCompleteZip;
property OnGetNextDisk: TGetNextDisk READ FOnGetNextDisk WRITE FOnGetNextDisk;
property OnUnZipComplete: TUnZipComplete READ FOnUnZipComplete WRITE FOnUnZipComplete;
property OnGetNextBuffer: TGetNextBuffer READ FOnGetNextBuffer WRITE FOnGetNextBuffer;
property OnDecrypt: TDecryptEvent READ FOnDecrypt WRITE FOnDecrypt;
property OEMConvert: Boolean read FOEMConvert write FOEMConvert default true;
end;
{$IFNDEF KPSMALL}
var
OpenZipDlg : TOpenDialog;
{$ENDIF}
{$IFNDEF FULLPACK}
procedure Register;
{$ENDIF}
{$IFDEF KPDEMO}
function DelphiIsRunning: Boolean;
{$ENDIF}
implementation
{$I kpUnzipp.Pas}
{******************************************************************}
constructor TVCLUnZip.Create(AOwner: TComponent);
{$IFDEF KPDEMO}
{$IFNDEF NO_RES}
var
tmpMstr2 : string;
{$ENDIF}
{$ENDIF}
begin
inherited Create(AOwner);
FSortMode := ByNone;
FDoAll := False;
RecreateDirs := False;
FFilesList := TStringList.Create;
file_info := CreateNewZipHeader; { 4/22/02 2.23+ }
{ file_info := TZipHeaderInfo.Create;} { Moved to Loaded 2/17/02 2.22+ }
Password := '';
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -