?? vclunzip.pas
字號:
{ ********************************************************************************** }
{ }
{ COPYRIGHT 1997 Kevin Boylan }
{ Source File: VCLUnZip.pas }
{ Description: VCLUnZip component - native Delphi unzip component. }
{ Date: March 1997 }
{ Author: Kevin Boylan, vclzip@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}
{$IFNDEF INT64STREAMS}
kphstrms,
{$ENDIF}
SysUtils, Classes,
kpSmall,
{$IFNDEF KPSMALL}
Controls, Forms, Dialogs, FileCtrl,
{$ENDIF}
kpCntn, kpMatch, KpLib, kpZipObj, kpzcnst;
{$I kpZTypes.Pas}
const
kpThisVersion = 305; {added this constant 3/1/98 for version 2.03}
kpThisBuild = 1;
{$IFNDEF ZLIB114}
ZLIB_VERSION = '1.2.2';
{$ELSE}
ZLIB_VERSION = '1.1.4';
{$ENDIF}
{$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, srExcludeList, srArchiveBitNotSet,srNoFileToFreshen,srSkippedInStartZip);
TSplitPartType = (spFirst, spMiddle, spLast);
TOperationMode = (omZip, omUnZip, omNone);
TBlockMode = (bmStandard, bmClassic);
{Decryption}
DecryptKey = array[0..2] of LongInt;
DecryptHeaderPtr = ^DecryptHeaderType;
DecryptHeaderType = array[0..11] of BYTE;
{ Exceptions }
EVCLZipException = class(Exception); { 6/25/03 3.02 }
EBadZipFile = class(EVCLZipException);
EFileNotAllThere = class(EVCLZipException);
EIncompleteZip = class(EVCLZipException);
ENotAZipFile = class(EVCLZipException);
EFatalUnzipError = class(EVCLZipException);
EUserCanceled = class(EVCLZipException);
EInvalidPassword = class(EVCLZipException);
EBiggerThanUncompressed = class(EVCLZipException); { 4/16/98 2.11 }
ENotEnoughRoom = class(EVCLZipException);
ECantWriteUCF = class(EVCLZipException);
ECanceledUnzipToBuffer = class(EVCLZipException);
EConfigFileSaveError = class(EVCLZipException);
{ 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;
TFileNameForSplitPartEvent = procedure(Sender: TObject; var FName: String; PartNum: Integer;
SplitType: TSplitPartType) of object;
THandleMessageEvent = procedure(Sender: TObject; const MessageID: Integer; const Msg1: String; const Msg2: String; const flags: LongWord; var Return: Integer) 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;
FThisBuild: 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: TOEMConvert; { 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;
FOnFileNameForSplitPart: TFileNameForSplitPartEvent;
FOnHandleMessage: THandleMessageEvent;
FArchiveStream: TkpStream;
FArchiveTStream: TStream;
FOperationMode: TOperationMode;
FBlockMode: TBlockMode;
FBusy: Boolean;
FRootDir: string;
FRelativePathList: TStrings;
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: LongWord;
theZipFile: TkpStream;
Crc32Val: U_LONG;
lrec: local_file_header;
{crec: central_file_header;} { Removed 4/22/02 2.23+ }
ecrec: TEndCentral;
ZipCommentPos: BIGINT;
UnZippingSelected: Boolean; { 6/27/99 2.18+ }
tmpMStr: string;
Key: DecryptKey;
CancelOperation: Boolean;
PauseOperation: Boolean;
ZipStream: TkpStream;
StreamZipping: Boolean;
MemZipping: Boolean;
MemBuffer: PChar;
MemLen: BIGINT;
MemLeft: BIGINT;
CurrMem: PChar;
Fixing: Boolean;
DR: Boolean;
FZipNameNoExtension: string;
TotalUncompressedSize: Comp;
TotalBytesDone: Comp;
procedure OpenZip;
procedure CloseZip;
function GetCount: Integer;
procedure GetFileInfo(infofile: TkpStream);
function GetZipName: string;
procedure SetZipName(ZName: string); VIRTUAL;
procedure SetArchiveStream(theStream: TkpStream);
function GetDestDir: string;
procedure SetDestDir(DDir: string);
procedure SetRootDir(Value: string);
function StripRelativePath( var path: String ): String;
function UnZipFiles(zip_in_file: TkpStream): Integer;
function UpdCRC(Octet: Byte; Crc: U_LONG): U_LONG;
function SwapDisk(NewDisk: Integer): TkpStream;
procedure SetFileComment(Index: Integer; theComment: string);
procedure SetZipComment(theComment: string);
procedure WriteNumDisks(NumberOfDisks: Integer);
procedure NewDiskEvent(Sender: TObject; var S: TkpStream);
procedure SetThisVersion(v: Integer);
procedure SetThisBuild(b: Integer);
function GetCheckDiskLabels: Boolean; VIRTUAL;
procedure SetCheckDiskLabels(Value: Boolean); VIRTUAL;
function CreateNewZipHeader: TZipHeaderInfo;
function SetBusy( value: Boolean ): Boolean;
function SetOperationMode( value: TOperationMode ): TOperationMode;
{ 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): BIGINT;
function GetUnCompressedSize(Index: Integer): BIGINT;
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: BIGINT;
function GetIsZip64: Boolean;
{Decryption}
function DecryptTheHeader(Passwrd: string; zfile: TkpStream): 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 DoFileNameForSplitPart(var FName: String; PartNum: Integer;
SplitType: TSplitPartType);
procedure DoGetNextDisk(NextDisk: Integer; var FName: string);
function DoHandleMessage(const MessageID: Integer; const Msg1: String; const Msg2: String; const flags: LongWord ): Integer;
procedure Loaded; OVERRIDE;
procedure DoPause;
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 PauseTheOperation;
procedure RestartTheOperation;
procedure AskForNewDisk(NewDisk: Integer);
procedure DefaultGetNextDisk(Sender: TObject; NextDisk: Integer; var FName: string);
procedure DefaultFileNameForSplitPart(Sender: TObject; var FName: String; PartNum: Integer;
SplitType: TSplitPartType);
function DefaultHandleMessage(const MessageID: Integer; const Msg1: String; const Msg2: String; const flags: LongWord): Integer;
function UnZipToStream(theStream: TkpStream; FName: string): Integer;
{$IFNDEF INT64STREAMS} overload;
function UnZipToStream(theStream: TMemoryStream; FName: string): Integer; overload;
function UnZipToStreamByIndex(theStream: TStream; Index: Integer): Integer; overload;
{$ENDIF}
function UnZipToStreamByIndex(theStream: TkpStream; Index: Integer): Integer;
{$IFNDEF INT64STREAMS} overload;
{$ENDIF}
function UnZipToBuffer(var Buffer: PChar; FName: string): Integer;
function UnZipToBufferByIndex(var Buffer: PChar; Index: Integer): Integer;
procedure ZLibDecompressStream(inStream, outStream: TStream; HttpCompression: Boolean = False);
procedure ZLibDecompressBuffer(const inBuffer: Pointer; inSize: Integer;
out outBuffer: Pointer; out outSize: Integer; outEstimate: Integer = 0; HttpCompression: Boolean = False);
function ZLibDecompressString(const s: string; HttpCompression: Boolean = False): String;
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: TkpStream 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]: BIGINT READ GetCompressedSize;
property UnCompressedSize[Index: Integer]: BIGINT 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: BIGINT 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;
property OperationMode: TOperationMode read FOperationMode;
property isZip64: Boolean read GetIsZip64;
PUBLISHED
{ Published declarations }
property ThisVersion: Integer READ FThisVersion WRITE SetThisVersion DEFAULT
kpThisVersion;
property ThisBuild: Integer READ FThisBuild WRITE SetThisBuild DEFAULT
kpThisBuild;
property ZipName: string READ GetZipName WRITE SetZipName;
property DestDir: string READ GetDestDir WRITE SetDestDir;
property RootDir: string READ FRootDir WRITE SetRootDir;
property RelativePathList: TStrings READ FRelativePathList WRITE FRelativePathList;
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;
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -