📄 vclunzip.pas
字号:
sortfiles := nil;
ecrec.Clear;
ZipIsBad := False;
filesDate := 0;
FNumDisks := 1;
MultiMode := mmNone;
if not ArchiveIsStream then
FZipName := '';
end;
procedure TVCLUnZip.ReadZip;
var
TryAgain : Boolean;
RememberKeepZipOpen : Boolean;
{$IFNDEF KPSMALL}
SaveCursor: TCursor;
{$ENDIF}
begin
CancelOperation := False;
FImproperZip := False;
repeat
{$IFNDEF KPSMALL}
SaveCursor := Screen.Cursor;
Screen.Cursor := crHourGlass;
{$ENDIF}
TryAgain := False;
try
OpenZip;
except
on EIncompleteZip do
begin
{$IFNDEF KPSMALL}
Screen.Cursor := SaveCursor;
{$ENDIF}
{ zip file must be closed in this case 1/25/00 2.20+ }
RememberKeepZipOpen := KeepZipOpen;
KeepZipOpen := False;
CloseZip;
KeepZipOpen := RememberKeepZipOpen;
if Assigned(FOnIncompleteZip) then
tryagain := True;
end;
else
begin
ClearZip;
{$IFNDEF KPSMALL}
Screen.Cursor := SaveCursor;
{$ENDIF}
raise; { raise the exception so the application knows }
end;
end;
until (TryAgain = False);
CloseZip;
{$IFNDEF KPSMALL}
Screen.Cursor := SaveCursor;
{$ENDIF}
end;
procedure TVCLUnZip.GetFileInfo(infoFile: TStream);
var
finfo : TZipHeaderInfo;
function ReadZipHardWay: Boolean;
var
sig : Byte;
AmtRead : LongInt;
CancelCheck : LongInt;
VerNeeded : WORD;
begin
Result := False;
if ZipIsBad then { We've already called this procedure }
exit;
ZipIsBad := True;
FImproperZip := True;
CancelCheck := 0;
if files <> nil then
begin
files.Free;
files := nil;
sortfiles := nil; { to avoid GPF in ClearZip if badzipfile 10/4/01 2.22+ }
end;
{ 4/19/98 2.11 skip past any sigs in code if sfx }
if (AnsiCompareText(ExtractFileExt(FZipName), '.EXE') = 0) then
infoFile.Seek(14000, soFromBeginning)
else
infoFile.Seek(0, soFromBeginning);
AmtRead := infoFile.Read(sig, SizeOf(sig));
repeat
repeat
repeat
repeat
while (AmtRead = SizeOf(sig)) and (sig <> LOC4) do
begin
Inc(CancelCheck);
if (DoProcessMessages) and (CancelCheck mod 10240 = 0) then
begin
{$IFNDEF KPSMALL}
Application.ProcessMessages;
{$ELSE}
YieldProcess;
{$ENDIF}
if CancelOperation then
begin
CancelOperation := False;
{$IFDEF NO_RES}
raise EUserCanceled.Create('User Aborted Operation');
{$ELSE}
raise EUserCanceled.Create(LoadStr(IDS_CANCELOPERATION));
{$ENDIF}
end;
end;
AmtRead := infoFile.Read(sig, SizeOf(sig));
end;
if AmtRead <> SizeOf(sig) then
Result := False
else
AmtRead := infoFile.Read(sig, SizeOf(sig));
until (AmtRead <> SizeOf(sig)) or (sig = LOC3);
AmtRead := infoFile.Read(sig, SizeOf(sig));
until (AmtRead <> SizeOf(sig)) or (sig = LOC2);
AmtRead := infoFile.Read(sig, SizeOf(sig));
until (AmtRead <> SizeOf(sig)) or (sig = LOC1);
AmtRead := infoFile.Read(VerNeeded, SizeOf(VerNeeded)); { Make sure not a sig in SFX Code }
until (AmtRead <> SizeOf(VerNeeded)) or (HIBYTE(VerNeeded) < 10);
if (AmtRead <> SizeOf(VerNeeded)) or (HIBYTE(VerNeeded) > 10) then
exit;
infoFile.Seek(-6, soFromCurrent);
files := TSortedZip.Create(DupError);
files.SortMode := ByNone; { Force for later compare }
sortfiles := files; { added 3/10/98 2.03 }
finfo.Free;
finfo := CreateNewZipHeader;
while finfo.ReadLocalFromStream(infoFile) do
begin
files.AddObject(finfo);
if finfo.HasDescriptor then
infoFile.Seek(finfo.compressed_size + finfo.Lextra_field_length +
SizeOf(DataDescriptorType), soFromCurrent)
else
infoFile.Seek(finfo.compressed_size + finfo.Lextra_field_length, soFromCurrent);
finfo := CreateNewZipHeader;
end;
finfo.Free;
finfo := nil;
ecrec.this_disk := 0;
CurrentDisk := 0;
ecrec.offset_central := infoFile.Seek(0, soFromCurrent); {assume}
ecrec.num_entries := Count;
FNumDisks := ecrec.this_disk + 1;
Result := True;
end;
procedure GetDescriptorInfo;
var
savepos : LongInt;
lrecord : local_file_header;
drecord : DataDescriptorType;
begin
with finfo do
begin
savepos := infoFile.Seek(0, soFromCurrent);
infoFile.Seek(relative_offset, soFromBeginning);
infoFile.Read(lrecord, SizeOf(lrecord));
infoFile.Seek(lrecord.filename_length + lrecord.compressed_size +
lrecord.extra_field_length, soFromCurrent);
infoFile.Read(drecord, SizeOf(drecord));
infoFile.Seek(savepos, soFromBeginning);
end;
end;
var
tmpfinfo, rem_info : TZipHeaderInfo;
i : Integer;
Index : Integer;
{sig : U_LONG;}
saveOffset : LongInt;
RootPath : string;
tmpStream : TStream;
recOK : Boolean;
InfoFromInfoFile : Boolean;
rem_efl : Word; {1/15/00 2.20+}
CommentLength : LongInt; {2/7/00 2.20+}
zcomment : String; {2/7/00 2.20+}
trys : Integer;
{$IFNDEF WIN32}
Disk : Integer;
{$ENDIF}
{$IFNDEF KPSMALL}
SaveCursor : TCursor;
{$ENDIF}
begin
{$IFNDEF KPSMALL}
SaveCursor := Screen.Cursor;
{$ENDIF}
tmpStream := nil;
rem_info := nil;
InfoFromInfoFile := False;
if (not ArchiveIsStream) then
filesDate := FileDateToDateTime(FileGetDate(TLFNFileStream(infoFile).Handle))
else
filesDate := Now;
if Count > 0 then
begin { force sortfiles to nil, avoid GPF in ClearZip if bad zip file 10/5/01 2.22+ }
if (sortfiles <> nil) and (FSortMode <> ByNone) then
sortfiles.Free;
sortfiles := nil;
files.Free;
files := nil;
end;
recOK := ecrec.ReadFromStream(infoFile);
{ Some things that would indicate a corrupt end of central }
{ 10/5/01 2.22+ }
if (ecrec.this_disk > 999)
or (ecrec.start_central_disk > 999)
or (ecrec.start_central_disk > ecrec.this_disk)
or (ecrec.offset_central < 0) then
recOK := false;
if (not recOK) then
begin
if (not ArchiveIsStream) and (FileExists(ChangeFileExt(ZipName, '.zfc'))) then
begin
tmpStream := infoFile;
infoFile := TFileStream.Create(ChangeFileExt(ZipName, '.zfc'), fmOpenRead);
recOK := ecrec.ReadFromStream(infoFile);
if recOK then
InfoFromInfoFile := True
else
begin
infoFile.Free;
infoFile := tmpStream;
end;
end;
end;
if (not recOK) then { False = couldn't find the end central directory }
begin
if not Fixing then
begin
if (Assigned(FOnIncompleteZip)) then
FOnIncompleteZip(Self, FIncompleteZipMode);
if (FIncompleteZipMode = izAssumeNotAZip) then
{$IFDEF NO_RES}
raise ENotAZipFile.Create('Not a valid zip file!');
{$ELSE}
raise ENotAZipFile.Create(LoadStr(IDS_INVALIDZIP));
{$ENDIF}
if (FIncompleteZipMode = izAssumeMulti) then
begin { Just return and let them try again with the right disk }
{$IFDEF NO_RES}
raise EIncompleteZip.Create('Incomplete Zip File');
{$ELSE}
raise EIncompleteZip.Create(LoadStr(IDS_INCOMPLETEZIP));
{$ENDIF}
end;
end;
if ((FIncompleteZipMode = izAssumeBad) or (Fixing)) then
begin
if not ReadZipHardWay then { False = there's no central directories }
begin
{$IFNDEF KPSMALL}
Screen.Cursor := SaveCursor;
{$ENDIF}
ClearZip;
{$IFDEF NO_RES}
raise EBadZipFile.Create('Not a valid zip file!');
{$ELSE}
raise EBadZipFile.Create(LoadStr(IDS_INVALIDZIP));
{$ENDIF}
end;
end;
end
else
begin { ************* }
CurrentDisk := ecrec.this_disk;
if InfoFromInfoFile then
CurrentDisk := 0;
if ecrec.this_disk > 0 then
begin
RootPath := UpperCase(LeftStr(FZipName, 3));
{$IFNDEF WIN32}
Disk := Ord(RootPath[1]) - 65; { -65 for 16bit GetDriveType }
{$ENDIF}
if RootPath[2] <> ':' then
MultiMode := mmBlocks
{$IFDEF WIN32}
else
if (GetDriveType(StringAsPChar(RootPath)) = DRIVE_REMOVABLE) then
{$ELSE}
else
if (GetDriveType(Disk) = DRIVE_REMOVABLE) then
{$ENDIF}
MultiMode := mmSpan
else
MultiMode := mmBlocks;
end
else
MultiMode := mmNone;
{ Moved the following down lower 3/10/98 2.03 }
{ if (ecrec.this_disk > 0) and (ecrec.ZipHasComment) then
GetZipComment; }
{ added check for MultiMode <> mmNone because of IMPLODED files that have this_disk = 0 but
start_central_disk = 1 8/17/98 2.15 }
if ecrec.num_entries > 0 then
begin
if ((not InfoFromInfoFile) and (MultiMode <> mmNone) and (ecrec.start_central_disk <>
CurrentDisk)) then
infoFile := SwapDisk(ecrec.start_central_disk + 1);
if (InfoFromInfoFile) then
infoFile.Seek(0, soFromBeginning)
else
infoFile.Seek(ecrec.offset_central, soFromBeginning);
end;
end; { ************* }
if (Count = 0) then { added test 02/14/99 2.17+ }
begin
files := TSortedZip.Create(DupError);
files.SortMode := ByNone;
sortfiles := files; { added 3/10/98 2.03 }
end;
rem_efl := 0; { Code to handle extra_field_len with no extra field 1/12/00 2.20+ }
i := 0;
while i < ecrec.num_entries do {for i := 0 to ecrec.num_entries - 1 do}
begin
finfo := CreateNewZipHeader;
trys := 0;
Repeat
if (ZipIsBad) or (MultiMode = mmNone) then
recOK := finfo.ReadCentralFromStream(infoFile, nil)
else
recOK := finfo.ReadCentralFromStream(infoFile, NewDiskEvent);
Inc(trys);
if (not recOK) and (trys = 1) and (rem_efl > 0) then
begin
if rem_info <> nil then
rem_info.Cextra_field_length := 0;
infoFile.Seek(-rem_efl, soFromCurrent);
rem_info := nil;
end;
Until (recOK) or (trys = 2) or (rem_efl = 0);
rem_efl := 0;
if not recOK then
begin
if ZipIsBad then { We've already called ReadZipHardWay }
begin { Must not be complete set of centrals }
finfo.Free;
finfo := nil;
break; { break from while loop }
end;
{ The following added 11/17/99 2.20b5+ }
{$IFDEF SKIPCODE} { 2/19/00 2.20+ }
if (Assigned(FOnIncompleteZip)) then
FOnIncompleteZip(Self, FIncompleteZipMode);
if ((FIncompleteZipMode = izAssumeBad) or (Fixing)) then
begin
{$ENDIF}
{ Since we are past looking for the end of central, we know we have a zip file.
We'll go ahead and try to ReadZipHardWay and set the new flag property called
ImproperZip so that it is known that something isn't quite kosher - since no
call to IncompleteZip is made now. A spanned zip set will always fail a call
to ReadZipHardWay. }
if (MultiMode <> mmNone) or (not ReadZipHardWay) then
begin
finfo.Free;
finfo := nil;
ClearZip;
{$IFDEF NO_RES}
raise EBadZipFile.Create('Not a valid zip file!');
{$ELSE}
raise EBadZipFile.Create(LoadStr(IDS_INVALIDZIP));
{$ENDIF}
end
else
begin
i := 0; {calling ReadZipHardWay brings us back to 1st central again}
continue; {try reading centrals again}
end;
{$IFDEF SKIPCODE} { 2/19/00 2.20+ }
end
else
begin
{$IFDEF NO_RES}
raise EBadZipFile.Create('Not a valid zip file!');
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -