?? vclunzip.pas
字號:
property FlushFilesOnClose: Boolean READ FFlushFilesOnClose WRITE FFlushFilesOnClose
DEFAULT False;
property BlockMode: TBlockMode read FBlockMode write FBlockMode default bmStandard;
{ 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: TOEMConvert read FOEMConvert write FOEMConvert default oemAlways;
property OnFileNameForSplitPart: TFileNameForSplitPartEvent read FOnFileNameForSplitPart
write FOnFileNameForSplitPart;
property OnHandleMessage: THandleMessageEvent read FOnHandleMessage write FOnHandleMessage;
end;
{$IFNDEF KPSMALL}
var
OpenZipDlg : TOpenDialog;
{$ENDIF}
{$IFNDEF FULLPACK}
procedure Register;
{$ENDIF}
{$IFDEF KPDEMO}
function DelphiIsRunning: Boolean;
{$ENDIF}
{$IFDEF USE_ZLIB}
type
TZAlloc = function (opaque: Pointer; items, size: Integer): Pointer;
TZFree = procedure (opaque, block: Pointer);
TZCompressionLevel = (zcNone, zcFastest, zcDefault, zcMax);
{** TZStreamRec ***********************************************************}
TZStreamRec = packed record
next_in : PChar; // next input byte
avail_in : Longint; // number of bytes available at next_in
total_in : Longint; // total nb of input bytes read so far
next_out : PChar; // next output byte should be put here
avail_out: Longint; // remaining free space at next_out
total_out: Longint; // total nb of bytes output so far
msg : PChar; // last error message, NULL if no error
state : Pointer; // not visible by applications
zalloc : TZAlloc; // used to allocate the internal state
zfree : TZFree; // used to free the internal state
opaque : Pointer; // private data object passed to zalloc and zfree
data_type: Integer; // best guess about the data type: ascii or binary
adler : Longint; // adler32 value of the uncompressed data
reserved : Longint; // reserved for future use
end;
type
EZLibError = class(Exception);
EZCompressionError = class(EZLibError);
EZDecompressionError = class(EZLibError);
{** link zlib code **********************************************************}
{$IFDEF ZLIB114} // MUST DEFINE ZLIB114 to get the older version
{$L deflate.obj}
{$L inflate.obj}
{$L infblock.obj}
{$L inftrees.obj}
{$L infcodes.obj}
{$L infutil.obj}
{$L inffast.obj}
{$L trees.obj}
{$L adler32.obj}
{$ELSE} // ZLIB_VERSION 1.2.2 is now the default
{$L zlib122\adler32.obj}
{$L zlib122\compress.obj}
{$L zlib122\crc32.obj}
{$L zlib122\deflate.obj}
{$L zlib122\infback.obj}
{$L zlib122\inffast.obj}
{$L zlib122\inflate.obj}
{$L zlib122\inftrees.obj}
{$L zlib122\trees.obj}
procedure adler32; external;
procedure compressBound; external;
procedure crc32; external;
{$ENDIF}
{*****************************************************************************
* note: do not reorder the above -- doing so will result in external *
* functions being undefined *
*****************************************************************************}
const
{** flush constants *******************************************************}
Z_NO_FLUSH = 0;
Z_PARTIAL_FLUSH = 1;
Z_SYNC_FLUSH = 2;
Z_FULL_FLUSH = 3;
Z_FINISH = 4;
{** return codes **********************************************************}
Z_OK = 0;
Z_STREAM_END = 1;
Z_NEED_DICT = 2;
Z_ERRNO = (-1);
Z_STREAM_ERROR = (-2);
Z_DATA_ERROR = (-3);
Z_MEM_ERROR = (-4);
Z_BUF_ERROR = (-5);
Z_VERSION_ERROR = (-6);
{** compression levels ****************************************************}
Z_NO_COMPRESSION = 0;
Z_BEST_SPEED = 1;
Z_BEST_COMPRESSION = 9;
Z_DEFAULT_COMPRESSION = (-1);
{** compression strategies ************************************************}
Z_FILTERED = 1;
Z_HUFFMAN_ONLY = 2;
Z_DEFAULT_STRATEGY = 0;
{** data types ************************************************************}
Z_BINARY = 0;
Z_ASCII = 1;
Z_UNKNOWN = 2;
{** compression methods ***************************************************}
Z_DEFLATED = 8;
{** return code messages **************************************************}
_z_errmsg: array[0..9] of PChar = (
'need dictionary', // Z_NEED_DICT (2)
'stream end', // Z_STREAM_END (1)
'', // Z_OK (0)
'file error', // Z_ERRNO (-1)
'stream error', // Z_STREAM_ERROR (-2)
'data error', // Z_DATA_ERROR (-3)
'insufficient memory', // Z_MEM_ERROR (-4)
'buffer error', // Z_BUF_ERROR (-5)
'incompatible version', // Z_VERSION_ERROR (-6)
''
);
ZLevels: array [TZCompressionLevel] of Shortint = (
Z_NO_COMPRESSION,
Z_BEST_SPEED,
Z_DEFAULT_COMPRESSION,
Z_BEST_COMPRESSION
);
SZInvalid = 'Invalid ZStream operation!';
{** deflate routines ********************************************************}
function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar;
recsize: Integer): Integer; external;
function deflateInit2_(var strm: TZStreamRec; level: Integer; method: Integer;
windowBits: Integer; memLevel: Integer; strategy: Integer; version: PChar;
recsize: Integer): Integer; external;
function deflate(var strm: TZStreamRec; flush: Integer): Integer;
external;
function deflateEnd(var strm: TZStreamRec): Integer; external;
{** inflate routines ********************************************************}
function inflateInit2_(var strm: TZStreamRec; WindowBits: Integer; version: PChar;
recsize: Integer): Integer; external;
function inflateInit_(var strm: TZStreamRec; version: PChar;
recsize: Integer): Integer; external;
function inflate(var strm: TZStreamRec; flush: Integer): Integer;
external;
function inflateEnd(var strm: TZStreamRec): Integer; external;
function inflateReset(var strm: TZStreamRec): Integer; external;
{** custom zlib routines ****************************************************}
function DeflateInit(var stream: TZStreamRec; level: Integer): Integer;
function DeflateInit2(var stream: TZStreamRec; level, method, windowBits,
memLevel, strategy: Integer): Integer;
function InflateInit(var stream: TZStreamRec): Integer;
function InflateInit2(var stream: TZStreamRec; windowBits: Integer): Integer;
function zcalloc(opaque: Pointer; items, size: Integer): Pointer;
procedure zcfree(opaque, block: Pointer);
function CCheck(code: Integer): Integer;
function DCheck(code: Integer): Integer;
procedure MoveI32(const Source; var Dest; Count: Integer); register;
{$ENDIF}
implementation
{$IFDEF USE_ZLIB}
{** custom zlib routines ****************************************************}
function DeflateInit(var stream: TZStreamRec; level: Integer): Integer;
begin
result := DeflateInit_(stream, level, ZLIB_VERSION, SizeOf(TZStreamRec));
end;
function DeflateInit2(var stream: TZStreamRec; level, method, windowBits,
memLevel, strategy: Integer): Integer;
begin
result := DeflateInit2_(stream, level, method, windowBits, memLevel, strategy, ZLIB_VERSION, SizeOf(TZStreamRec));
end;
function InflateInit(var stream: TZStreamRec): Integer;
begin
result := InflateInit_(stream, ZLIB_VERSION, SizeOf(TZStreamRec));
end;
function InflateInit2(var stream: TZStreamRec; windowBits: Integer): Integer;
begin
result := InflateInit2_(stream, windowBits, ZLIB_VERSION, SizeOf(TZStreamRec));
end;
function zcalloc(opaque: Pointer; items, size: Integer): Pointer;
begin
GetMem(result,items * size);
end;
procedure zcfree(opaque, block: Pointer);
begin
FreeMem(block);
end;
procedure _memset(P: Pointer; B: Byte; count: Integer); cdecl;
begin
FillChar(P^, count, B);
end;
procedure _memcpy(dest, source: Pointer; count: Integer); cdecl;
begin
Move(source^, dest^, count);
end;
function _malloc(Size: Integer): Pointer; cdecl;
begin
Result := AllocMem(Size);
end;
procedure _free(Block: Pointer); cdecl;
begin
FreeMem(Block);
end;
function CCheck(code: Integer): Integer;
begin
Result := code;
if code < 0 then
raise EZCompressionError.Create('error'); //!!
end;
function DCheck(code: Integer): Integer;
begin
Result := code;
if code < 0 then
raise EZDecompressionError.Create('error'); //!!
end;
procedure MoveI32(const Source; var Dest; Count: Integer); register;
asm
cmp ECX,0
Je @JustQuit
push ESI
push EDI
mov ESI, EAX
mov EDI, EDX
@Loop:
Mov AL, [ESI]
Inc ESI
mov [EDI], AL
Inc EDI
Dec ECX
Jnz @Loop
pop EDI
pop ESI
@JustQuit:
end;
{$ENDIF}
{$I kpUnzipp.Pas}
{******************************************************************}
constructor TVCLUnZip.Create(AOwner: TComponent);
{$IFDEF KPDEMO}
var
tmpMstr2 : string;
{$ENDIF}
begin
inherited Create(AOwner);
FSortMode := ByNone;
FDoAll := False;
RecreateDirs := False;
FFilesList := TStringList.Create;
FRelativePathList := TStringList.Create;
file_info := CreateNewZipHeader; { 4/22/02 2.23+ }
{ file_info := TZipHeaderInfo.Create;} { Moved to Loaded 2/17/02 2.22+ }
Password := '';
ZipIsBad := False;
theZipFile := nil;
files := nil;
sortfiles := nil;
FIncompleteZipMode := izAssumeMulti;
ecrec := TEndCentral.Create;
CancelOperation := False;
PauseOperation := False;
FKeepZipOpen := False;
FDoProcessMessages := True;
FCheckDiskLabels := True;
StreamZipping := False;
MemZipping := False;
MemBuffer := nil;
MemLen := 0;
ArchiveIsStream := False;
Fixing := False;
FNumDisks := 1;
CurrentDisk := 0;
FRetainAttributes := True;
FBusy := False;
FTestMode := False;
FThisVersion := kpThisVersion;
FThisBuild := kpThisBuild;
FReplaceReadOnly := False; { 03/09/99 2.17+ }
FNumSelected := 0;
FBufferLength := 0;
FImproperZip := False;
FBufferedStreamSize := DEF_BUFSTREAMSIZE;
FEncryptBeforeCompress := False;
FOEMConvert := oemAlways; { 2/17/02 2.22+ }
FBlockMode := bmStandard;
{$IFDEF KPDEMO}
if not (csDesigning in ComponentState) then
begin
DR := DelphiIsRunning;
if not DelphiIsRunning then
begin
tmpMStr := LoadStr(IDS_NOTREGISTERED);
tmpMStr2 := LoadStr(IDS_WARNING);
//MessageBox(0, StringAsPChar(tmpMStr), StringAsPChar(tmpMStr2), mb_OK);
DoHandleMessage(IDS_NOTREGISTERED,StringAsPChar(tmpMStr), StringAsPChar(tmpMStr2), mb_OK);
Abort;
end;
end;
{$ENDIF}
end;
destructor TVCLUnZip.Destroy;
begin
ClearZip;
if (file_info <> nil) then
file_info.Free;
if (ecrec <> nil) then
ecrec.Free;
{ Moved folowing down two lines 7/10/98 2.13 }
{ Due to a user's reporting that it stopped him from getting "Invalid Pointer Operation"
{ errors. I was unable to duplicate the problem but the move is safe enough }
if (FFilesList <> nil) then
FFilesList.Free;
if (FRelativePathList <> nil) then
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -