📄 vclunzip.pas
字号:
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;
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 := TZipHeaderInfo.Create;
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 := TZipHeaderInfo.Create;
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}
begin
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
if (sortfiles <> nil) and (FSortMode <> ByNone) then
begin
sortfiles.Free;
sortfiles := nil;
end;
files.Free;
files := nil;
end;
recOK := ecrec.ReadFromStream(infoFile);
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 := crDefault;
{$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);
{$IFDEF SKIPCODE}
infoFile.Read(sig, SizeOf(sig));
if sig <> CENTSIG then
begin
{ The following added 11/17/99 2.20b5+ }
if (Assigned(FOnIncompleteZip)) then
FOnIncompleteZip(Self, FIncompleteZipMode);
if ((FIncompleteZipMode = izAssumeBad) or (Fixing)) then
begin
if not ReadZipHardWay then
begin
ClearZip;
{$IFDEF NO_RES}
raise EBadZipFile.Create('Not a valid zip file!');
{$ELSE}
raise EBadZipFile.Create(LoadStr(IDS_INVALIDZIP));
{$ENDIF}
end;
end
else
begin
{$IFDEF NO_RES}
raise EBadZipFile.Create('Not a valid zip file!');
{$ELSE}
raise EBadZipFile.Create(LoadStr(IDS_INVALIDZIP));
{$ENDIF}
end;
{-------------------------- end of mod 11/17/99 2.20b5+}
end
else
infoFile.Seek(-4, soFromCurrent);
{$ENDIF}
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 := TZipHeaderInfo.Create;
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!');
{$ELSE}
raise EBadZipFile.Create(LoadStr(IDS_INVALIDZIP));
{$ENDIF}
end;
{$ENDIF}
{-------------------------- end of mod 11/17/99 2.20b5+}
end;
if ZipIsBad then
begin
if (files.Search(Pointer(finfo), Index)) then
begin
tmpfinfo := files.Items[Index] as TZipHeaderInfo;
saveOffset := tmpfinfo.relative_offset;
tmpfinfo.Assign(finfo);
tmpfinfo.relative_offset := saveOffset;
rem_info := tmpfinfo;
{ 3/28/00 2,21p1+ }
infoFile.Seek(finfo.Cextra_field_length + crec.file_comment_length, soFromCurrent);
finfo.Free;
finfo := nil;
end
else { don't mess with it if there's no local header }
begin
finfo.Free;
finfo := nil;
Inc(i);
continue;
end;
end;
if not ZipIsBad then
begin
try
files.AddObject(finfo); { If ZipIsBad then it has already been added }
except
if (ReadZipHardWay) then
begin
i := 0;
continue;
end
else
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -