📄 kpunzipp.pas
字号:
end;
If PauseOperation then
DoPause;
end;
number_to_read := kpmin( file_info.compressed_size, LongInt(INBUFSIZ) );
file_info.compressed_size := file_info.compressed_size - number_to_read;
number_read := zip_in_file.Read( outbuf^, number_to_read );
incnt := number_read;
If (((ecrec.this_disk = 0))
and (incnt < number_to_read)) then
raise EFatalUnzipError.Create(LoadStr(IDS_PREMEND));
tmpbuf := outbuf;
While (incnt < number_to_read) do {2/1/98 Changed If to While}
begin
zip_in_file := SwapDisk( CurrentDisk+2 );
If zip_in_file = nil then {2/1/98}
raise EUserCanceled.Create(LoadStr(IDS_CANCELOPERATION));
Inc(tmpbuf,number_read);
number_read := zip_in_file.Read( tmpbuf^, number_to_read-incnt );
Inc(incnt, number_read);
end;
{$IFDEF SKIPCODE}
if file_info.Encrypted then { added 11/2/97 }
begin
if (not assigned(FOnDecrypt)) then
decrypt_buff( outbuf, outcnt ) { KLB }
else
begin
FOnDecrypt( self, outbuf, outcnt, Password );
end;
end;
{$ENDIF}
{file_info.compressed_size := file_info.compressed_size - outcnt;}
xFlushOutput;
outcnt := kpmin( file_info.compressed_size, OUTBUFSIZ );
end;
end;
procedure Skip_Rest;
{ skip past current compressed file to the next one }
begin
{zip_in_file.Seek( file_info.compressed_size, soFromCurrent );} { Removed 4/22/98 2.11 }
TotalUncompressedSize := TotalUncompressedSize - file_info.compressed_size;
Dec(FileCount);
end;
procedure Do_Unzip( Index: Integer );
{ Unzips file[Index] }
var
MsgArray: array [0..300] of char; {For 16 bit's sake}
zip_out_file_name: String;
CRCHighByte, DecryptCRCByte: BYTE;
{CRCHighWord, DecryptCRCWord: WORD;}
OverWriteIt: Boolean;
Skip: Boolean;
FullPath: String;
FinishedOK: Boolean;
FileHandle: Integer;
InternalDir: String;
NewPassword: String;
AllocatedBuffer: Boolean;
testDate: TDateTime;
GoOn, FirstTime: Boolean;
attrs: Integer;
tmpMStr2: String;
function GetFullPath: String;
begin
Result := '';
if (RecreateDirs) and (file_info.directory <> '') then
begin
InternalDir := file_info.directory;
If (RelativePathList.Count > 0) then
StripRelativePath(InternalDir);
//If (RootDir <> '') and (AnsiCompareText(LeftStr(InternalDir,Length(RootDir)),RootDir) = 0) then
// Delete(InternalDir,1,Length(RootDir));
{ The directory in the zip file could be absolute }
if (InternalDir <> '') and ((InternalDir[1] = '\') or (InternalDir[2] = ':')) then
begin
If DestDir = '' then
Result := InternalDir
Else
begin
If (InternalDir[1] = '\') then
Result := DestDir + InternalDir
Else
Result := DestDir + RightStr( InternalDir, Length(InternalDir)-2);
end;
end
else { otherwise just append it to the destination directory }
Result := DestDir + '\' + InternalDir;
{if (not DirExists( FullPath )) and (not FTestMode) then
ForceDirs( FullPath );} { Create dest directory if it doesn't exist }
end
Else
Result := DestDir + '\';
end;
var
SkipCRC_Check: Boolean;
begin
FinishedOK := False;
AllocatedBuffer := False;
zip_out_file_name := '';
Skip := False;
RepeatFile := False;
SkipCRC_Check := False;
file_info.Assign(sortfiles.Items[Index] as TZipHeaderInfo); { Make a copy }
If (file_info.filename <> '') then { must be a directory entry }
begin
If (ecrec.this_disk > 0) and (file_info.disk_number_start <> CurrentDisk) then
zip_in_file := SwapDisk( file_info.disk_number_start+1 );
zip_in_file.Seek( file_info.relative_offset, soBeginning );
zip_in_file.Read( lrec, SizeOf(local_file_header) );
zip_in_file.Seek( lrec.extra_field_length + lrec.filename_length, soCurrent );
end;
FullPath := GetFullPath;
If file_info.filename = '' then { it's just a directory entry }
begin
{If (RecreateDirs) and (Assigned( FOnStartUnZip )) then
FOnStartUnZip( self, Index, FullPath, Skip );}
{ Added following 6/27/99 2.18+ }
if (not StreamZipping) and (not MemZipping) and
(RecreateDirs) and (not DirExists( FullPath )) then
ForceDirs( FullPath ); { Create dest directory if it doesn't exist }
Inc(NumUnZipped);
exit;
end;
If (not StreamZipping) and (not MemZipping) then
begin
{$IFDEF SKIPCODE}
if (RecreateDirs) and (file_info.directory <> '') then
begin
InternalDir := file_info.directory;
If (RootDir <> '') and (AnsiCompareText(LeftStr(InternalDir,Length(RootDir)),RootDir) = 0) then
Delete(InternalDir,1,Length(RootDir));
{ The directory in the zip file could be absolute }
if (InternalDir <> '') and ((InternalDir[1] = '\') or (InternalDir[2] = ':')) then
begin
If DestDir = '' then
FullPath := InternalDir
Else
begin
If (InternalDir[1] = '\') then
FullPath := DestDir + InternalDir
Else
FullPath := DestDir + RightStr( InternalDir, Length(InternalDir)-2);
end;
end
else { otherwise just append it to the destination directory }
FullPath := DestDir + '\' + InternalDir;
{if (not DirExists( FullPath )) and (not FTestMode) then
ForceDirs( FullPath );} { Create dest directory if it doesn't exist }
end
Else
FullPath := DestDir + '\';
{$ENDIF}
zip_out_file_name := FullPath + file_info.filename;
end;
{ --------------------------------------------------------------------------------------------}
{ Moved to here, before opening the file and changed the filename parameter to VAR so that }
{ the destination of the file can be changed in the OnStartUnZip event. 03/20/99 2.17+ }
If Assigned( FOnStartUnZip ) then
FOnStartUnZip( self, Index, zip_out_file_name, Skip );
If Skip then
exit;
{ Moved to here since the path and filename might have been changed in the OnStartUnZip event }
{ 03/20/99 2.17+ }
If (not StreamZipping) and (not MemZipping) and (not FTestMode) then
begin
FullPath := ExtractFileDir(zip_out_file_name);
if (not DirExists( FullPath )) then
ForceDirs( FullPath ); { Create dest directory if it doesn't exist }
end;
{ --------------------------------------------------------------------------------------------}
If (file_info.Encrypted) then
begin
NewPassword := Password;
While NewPassword = Password do
begin
If file_info.HasDescriptor then
CRCHighByte := HIBYTE(LOWORD( file_info.last_mod_file_date_time ))
Else
CRCHighByte := HIBYTE(HIWORD( file_info.crc32));
DecryptCRCByte := DecryptTheHeader( Password, zip_in_file );
if CRCHighByte <> DecryptCRCByte then
begin
NewPassword := Password;
If Assigned( FOnBadPassword ) then
begin
FOnBadPassword( self, Index, NewPassword );
If NewPassword <> Password then
begin
Password := NewPassword;
zip_in_file.Seek(-SizeOf(DecryptHeaderType),soCurrent);
file_info.compressed_size := file_info.compressed_size + SizeOf(DecryptHeaderType);
Continue;
end;
end;
If Assigned( FOnSkippingFile ) then
FOnSkippingFile( self, srBadPassword, file_info.directory+file_info.filename, Index, Retry );
Skip_Rest; {skip file}
exit;
end
Else NewPassword := '';
end;
end;
csize := file_info.compressed_size;
ucsize := file_info.uncompressed_size;
If (not StreamZipping) and (not MemZipping) then
begin
If (FOverwriteMode <> Always) and (File_Exists(zip_out_file_name)) then
begin
If FOverwriteMode = Prompt then { Allow application to determine if overwrite }
begin
If Assigned( FOnPromptForOverwrite ) then
begin
OverWriteIt := False; { Assume we skip just to be safe }
FOnPromptForOverwrite( self, OverWriteIt, Index, zip_out_file_name );
end
Else { FOnPromptForOverwrite event not assigned so we have to ask user ourselves }
begin
StrPCopy( MsgArray, LoadStr(IDS_REPLACEFILE) + Filename[Index] + '?' );
tmpMStr := LoadStr(IDS_FILEXISTALERT);
//OverWriteIt := MessageBox( 0, MsgArray, StringAsPChar(tmpMStr), MB_YESNO) = IDYES;
OverWriteIt := DoHandleMessage(IDS_FILEXISTALERT,MsgArray, StringAsPChar(tmpMStr), MB_YESNO) = IDYES;
end;
If not OverWriteIt then
begin
If Assigned( FOnSkippingFile ) then
FOnSkippingFile( self, srNoOverwrite, zip_out_file_name, Index, Retry );
Skip_Rest; {skip file}
exit;
end;
end
Else If (FOverwriteMode = Never) then { Never Overwrite }
begin
If Assigned( FOnSkippingFile ) then
FOnSkippingFile( self, srNoOverwrite, zip_out_file_name, Index, Retry );
Skip_Rest; {skip file}
exit;
end
Else { ifNewer and ifOlder 8/2/98 2.14 }
begin
testDate := FileDateToDateTime(FileAge(zip_out_file_name));
If (FOverwriteMode = ifNewer) then
begin
If (FileDateToDateTime( file_info.last_mod_file_date_time ) <= testDate) then
begin
If Assigned( FOnSkippingFile ) then
FOnSkippingFile( self, srNoOverwrite, zip_out_file_name, Index, Retry );
Skip_Rest; {skip file}
exit;
end;
end
Else
begin
If (FileDateToDateTime( file_info.last_mod_file_date_time ) >= testDate) then
begin
If Assigned( FOnSkippingFile ) then
FOnSkippingFile( self, srNoOverwrite, zip_out_file_name, Index, Retry );
Skip_Rest; {skip file}
exit;
end;
end;
end;
end;
GoOn := False;
FirstTime := True;
Repeat { Added ReplaceReadOnly 03/07/99 2.17+ }
try
zip_out_file := TLFNFileStream.CreateFile( zip_out_file_name, fmCreate, FFlushFilesOnClose,
BufferedStreamSize );
zip_out_file.Size := file_info.uncompressed_size;
zip_out_file.Position := 0;
GoOn := True;
except
On EFCreateError do {ReadOnly will cause EFCreateError}
begin
If FReplaceReadOnly and FirstTime then
begin
FirstTime := False; { We'll only try this once }
attrs := FileGetAttr(zip_out_file_name);
if ((attrs and faReadOnly) > 0) then
begin
attrs := attrs and (not faReadOnly); {Turn off ReadOnly bit}
FileSetAttr(zip_out_file_name, attrs) {And reset the attributes}
end;
end
else
begin {Skip if we still can't open or we}
If Assigned( FOnSkippingFile ) then {don't want to replace readonly }
FOnSkippingFile( self, srCreateError, zip_out_file_name, Index, Retry );
Skip_Rest;
exit;
end;
end;
else
begin
If Assigned( FOnSkippingFile ) then {can't create the file for some reason }
FOnSkippingFile( self, srCreateError, zip_out_file_name, Index, Retry );
Skip_Rest;
exit;
end;
end;
Until GoOn;
end { If not UnZippingToStream }
Else
begin
If (StreamZipping) then
begin
if ZipStream.Size = 0 then
ZipStream.Size := file_info.uncompressed_size;
zip_out_file := ZipStream; { UnZipping to a stream }
zip_out_file.Position := 0;
end
Else
begin { UnZipping to memory buffer }
AllocatedBuffer := False;
If (MemBuffer = nil) then
begin
GetMem( MemBuffer, file_info.uncompressed_size);
AllocatedBuffer := True;
end;
CurrMem := MemBuffer;
MemLeft := file_info.uncompressed_size;
MemLen := file_info.uncompressed_size;
end;
end;
try
try
bits_left := 0;
bitbuf := 0;
outpos := 0;
incnt := 0;
outcnt := 0;
inptr := inbuf;
outptr := outbuf;
Crc32Val := $FFFFFFFF;
{CurrentDisk := 0;}
{ Skip := False;
If Assigned( FOnStartUnZip ) then
FOnStartUnZip( self, Index, zip_out_file_name, Skip );
If Skip then
exit;
}
{Just incase they did something in an event that changed the filepointer} {4/9/99 2.18b4+}
zip_in_file.Seek( file_info.relative_offset, soBeginning );
zip_in_file.Seek( SizeOf(local_file_header) + lrec.extra_field_length +
lrec.filename_length, soCurrent );
If (file_info.Encrypted) then
zip_in_file.Seek( 12, soCurrent ); { If the file is encrypted }
Case file_info.compression_method of
STORED: UnStore;
DEFLATED: kpInflate;
{$IFNDEF INFLATE_ONLY}
SHRUNK: UnShrink;
REDUCED1,
REDUCED2,
REDUCED3,
REDUCED4: UnReduce;
IMPLODED: Explode;
{$ENDIF}
else
if (not FTestMode) then
begin
TmpMStr := LoadStr(IDS_UNKNOWNMETH);
TmpMStr2 := LoadStr(IDS_ZIPERROR);
//MessageBox( 0, StringAsPChar(TmpMStr), StringAsPChar(TmpMStr2), mb_OK );
DoHandleMessage(IDS_UNKNOWNMETH, StringAsPChar(TmpMStr), StringAsPChar(TmpMStr2), mb_OK );
end;
end; { Case }
FinishedOK := True;
except { 4/16/98 2.11 }
On EBiggerThanUncompressed do
FinishedOK := False; { Bad CRC should be called later }
On ECanceledUnZipToBuffer do
begin
FinishedOK := False;
SkipCRC_Check := True;
end;
end;
finally
If (not StreamZipping) and (not MemZipping) then
begin
zip_out_file.Free;
zip_out_file := nil;
If (FinishedOK) then
begin
FileHandle := FileOpen(zip_out_file_name, fmOpenWrite or fmShareDenyNone);
FileSetDate(FileHandle, GoodTimeStamp(file_info.last_mod_file_date_time));
FileClose(FileHandle);
{ Moved the following from before setting date because if read-only setting
the date was not possible } { 1/18/00 2.20+ }
If RetainAttributes then
FileSetAttr( zip_out_file_name, file_info.external_file_attributes );
end;
end;
If (MemZipping) and (not FinishedOK) then
begin
If (AllocatedBuffer) then
FreeMem(MemBuffer, file_info.uncompressed_size);
MemBuffer := nil;
end;
end; { try }
Crc32Val := not Crc32Val;
If (not SkipCRC_Check) and (Crc32Val <> file_info.crc32) then
begin
If (file_info.Encrypted) then { bad password entered }
begin
If Assigned( FOnBadPassword ) then
begin
NewPassword := Password;
FOnBadPassword( self, Index, NewPassword );
If NewPassword <> Password then
begin
Password := NewPassword;
RepeatFile := True;
end;
end;
If (not RepeatFile) and Assigned( FOnSkippingFile ) then
FOnSkippingFile( self, srBadPassword, file_info.directory+file_info.filename, Index, Retry );
end
Else If (Assigned( FOnBadCRC )) then
FOnBadCRC( self, Crc32Val, file_info.crc32, Index );
If (not StreamZipping) and (not MemZipping) then
SysUtils.DeleteFile( zip_out_file_name );
If (not RepeatFile) then
Dec(FileCount);
end
Else
begin
If Assigned( FOnEndUnZip ) then
FOnEndUnZip( self, Index, zip_out_file_name );
Inc(NumUnZipped);
end;
end;
{******************************************************************************************}
var
i, j: Integer;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -