?? vclunzip.pas
字號:
try
OpenZip;
theZipFile.Seek(relative_offset, soFromBeginning);
theZipFile.Read(lrec, SizeOf(local_file_header));
with lrec do
begin
theZipFile.Seek(filename_length, soFromCurrent);
theZipFile.Read(dhTemp, SizeOf(DecryptHeaderType));
end;
for i := 0 to 11 do { added this loop 10/23/99 2.20b3+ }
begin
dhPtr^ := dhTemp[i];
Inc(dhPtr);
end;
finally
If (MultiMode = mmNone) then
CloseZip;
end;
end;
{$ENDIF}
end;
{$IFDEF ISDELPHI}
function TVCLUnZip.GetDecryptHeader(Index: Integer): DecryptHeaderType;
var
finfo : TZipHeaderInfo;
lrec : local_file_header;
i : Integer;
begin
if (Index > -1) and (Index < Count) then
begin
finfo := sortfiles.Items[Index] as TZipHeaderInfo;
else
{$IFDEF NO_RES}
raise EListError.CreateFmt('Index %d is out of range', [Index]);
{$ELSE}
raise EListError.CreateFmt(LoadStr(IDS_INDEXOUTOFRANGE), [Index]);
{$ENDIF}
if (IsEncrypted[Index]) then
with finfo do
begin
try
OpenZip;
theZipFile.Seek(relative_offset, soFromBeginning);
theZipFile.Read(lrec, SizeOf(local_file_header));
with lrec do
begin
theZipFile.Seek(filename_length, soFromCurrent);
theZipFile.Read(Result, SizeOf(DecryptHeaderType));
end;
finally
If (MultiMode = mmNone) then
CloseZip;
end
end
else
for i := 0 to 11 do
Result[i] := 0;
end;
{$ENDIF}
function TVCLUnZip.GetZipSize: LongInt;
begin
Result := 0;
if FZipName <> '' then
begin
OpenZip;
try
Result := theZipFile.Size;
finally
If (MultiMode = mmNone) then
CloseZip;
end;
end;
end;
procedure TVCLUnZip.WriteNumDisks(NumberOfDisks: Integer);
begin
FNumDisks := NumberOfDisks;
end;
{ Added these so that they could be overriden in VCLZip 3/11/98 2.03 }
function TVCLUnZip.GetCheckDiskLabels: Boolean;
begin
Result := FCheckDiskLabels;
end;
procedure TVCLUnZip.SetCheckDiskLabels(Value: Boolean);
begin
FCheckDiskLabels := Value;
end;
function TVCLUnZip.UnZip: Integer;
begin
FBusy := True;
CancelOperation := False;
Result := 0;
try
if DestDir <> '?' then
begin
{ Following Changed from OpenZip which was being bypassed. 03/15/01 2.21+ }
ReadZip;
OpenZip; { Make sure it's open because ReadZip closes it again }
Result := UnzipFiles(theZipFile);
CloseZip;
end;
finally
FBusy := False;
CancelOperation := False;
end;
end;
function TVCLUnZip.UnZipSelected: Integer;
begin
UnZippingSelected := True;
Result := UnZip;
UnZippingSelected := False;
end;
procedure TVCLUnZip.ClearSelected;
var
i : Integer;
begin
for i := 0 to Count - 1 do
Selected[i] := False;
FNumSelected := 0;
end;
function TVCLUnZip.UnZipToStream(theStream: TStream; FName: string): Integer;
begin
Result := 0;
if (Trim(FName) = '') or (theStream = nil) then
exit;
FBusy := True;
ZipStream := theStream;
CancelOperation := False;
StreamZipping := True;
OpenZip;
FilesList.Clear;
FilesList.Add(FName);
try
Result := UnzipFiles(theZipFile);
finally
StreamZipping := False;
CloseZip;
FBusy := False;
CancelOperation := False;
end;
end;
function TVCLUnZip.UnZipToStreamByIndex(theStream: TStream; Index: Integer): Integer;
begin
Result := 0;
if (theStream = nil) then
exit;
FBusy := True;
ZipStream := theStream;
CancelOperation := False;
StreamZipping := True;
OpenZip;
FilesList.Clear;
try
Selected[Index] := True;
UnZippingSelected := True;
Result := UnzipFiles(theZipFile);
finally
StreamZipping := False;
CloseZip;
FBusy := False;
CancelOperation := False;
UnZippingSelected := False;
end;
end;
function TVCLUnZip.UnZipToBuffer(var Buffer: PChar; FName: string): Integer;
begin
Result := 0;
if (Trim(FName) = '') then
exit;
FBusy := True;
MemZipping := True;
OpenZip; { 12/4/98 2.17P+ }
FilesList.Clear;
FilesList.Add(FName);
if (Buffer = nil) then
MemBuffer := nil
else
MemBuffer := Buffer;
try
Result := UnzipFiles(theZipFile);
if (Buffer = nil) then
Buffer := MemBuffer;
finally
MemZipping := False;
CloseZip;
FBusy := False;
CancelOperation := False;
MemBuffer := nil;
end;
end;
function TVCLUnZip.UnZipToBufferByIndex(var Buffer: PChar; Index: Integer): Integer;
begin
FBusy := True;
MemZipping := True;
OpenZip; { 12/4/98 2.17P+ }
FilesList.Clear;
if (Buffer = nil) then
MemBuffer := nil
else
MemBuffer := Buffer;
try
if Index > -1 then
Selected[Index] := True;
if not DoAll then
UnZippingSelected := True;
Result := UnzipFiles(theZipFile);
if (Buffer = nil) then
Buffer := MemBuffer;
finally
MemZipping := False;
CloseZip;
FBusy := False;
CancelOperation := False;
MemBuffer := nil;
UnZippingSelected := False;
end;
end;
procedure TVCLUnZip.OpenZip;
{$IFDEF KPDEMO}
{$IFNDEF NO_RES}
var
tmpMStr2 : string;
{$ENDIF}
{$ENDIF}
begin
{$IFDEF KPDEMO}
if not (csDesigning in ComponentState) then
begin
if not DelphiIsRunning then
begin
{$IFDEF NO_RES}
MessageBox(0,
'This unregistered verion of VCLZip will only run while the Delphi IDE is running',
'Warning', mb_OK);
{$ELSE}
tmpMStr := LoadStr(IDS_NOTREGISTERED);
tmpMStr2 := LoadStr(IDS_WARNING);
MessageBox(0, StringAsPChar(tmpMStr), StringAsPChar(tmpMStr2), mb_OK);
{$ENDIF}
Abort;
end;
end;
{$ENDIF}
if theZipFile = nil then
theZipFile := TLFNFileStream.CreateFile(FZipName, fmOpenRead or fmShareDenyWrite,
FFlushFilesOnClose, BufferedStreamSize);
if files = nil then
GetFileInfo(theZipFile)
else
if (not ArchiveIsStream) and
(FileDateToDateTime(FileGetDate(TLFNFileStream(theZipFile).Handle)) <> filesDate) then
GetFileInfo(theZipFile);
end;
procedure TVCLUnZip.CloseZip;
begin
if not FKeepZipOpen then
begin
theZipFile.Free;
theZipFile := nil;
end;
end;
procedure TVCLUnZip.AskForNewDisk(NewDisk: Integer);
begin
SwapDisk(NewDisk);
end;
function TVCLUnZip.SwapDisk(NewDisk: Integer): TStream;
{ NewDisk is the disk number that the user sees. Starts with 1 }
var
tmpZipName : string;
function CurrentDiskLabel(NewDisk: Integer): Boolean;
var
VolName : string[11];
Disk : string;
begin
{Need to check disk label here}
if MultiMode = mmSpan then
begin
Disk := UpperCase(LeftStr(FZipName, 3));
VolName := GetVolumeLabel(Disk);
if RightStr(VolName, 3) = Format('%3.3d', [NewDisk]) then
Result := True
else
Result := False;
end
else
Result := True;
end;
begin
theZipFile.Free;
theZipFile := nil; {1/27/98 to avoid GPF when Freeing file in CloseZip. v2.00+}
tmpZipName := FZipName;
repeat
repeat
FOnGetNextDisk(Self, NewDisk, tmpZipName);
until (not CheckDiskLabels) or (tmpZipName = '') or (CurrentDiskLabel(NewDisk));
if tmpZipName = '' then
raise EUserCanceled.Create('User canceled loading new disk.');
until FileExists(tmpZipName); {1/29/98 To avoid problem if file doesn't exist}
theZipFile := TLFNFileStream.CreateFile(tmpZipName, fmOpenRead, False, BufferedStreamSize);
CurrentDisk := NewDisk - 1; { CurrentDisk starts with 0 }
filesDate := FileDateToDateTime(FileGetDate(TLFNFileStream(theZipFile).Handle));
FZipName := tmpZipName;
Result := theZipFile;
end;
procedure TVCLUnZip.NewDiskEvent(Sender: TObject; var S: TStream);
begin
SwapDisk(CurrentDisk + 2);
S := theZipFile;
end;
procedure TVCLUnZip.ClearZip;
var
SaveKeepZipOpen : Boolean;
begin
SaveKeepZipOpen := FKeepZipOpen;
FKeepZipOpen := False;
CloseZip;
FKeepZipOpen := SaveKeepZipOpen;
if (sortfiles <> nil) and (sortfiles <> files) then
sortfiles.Free;
files.Free;
files := nil;
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;
begin
CancelOperation := False;
FImproperZip := False;
repeat
{$IFNDEF KPSMALL}
Screen.Cursor := crHourGlass;
{$ENDIF}
TryAgain := False;
try
OpenZip;
except
on EIncompleteZip do
begin
{$IFNDEF KPSMALL}
Screen.Cursor := crDefault;
{$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 := crDefault;
{$ENDIF}
raise; { raise the exception so the application knows }
end;
end;
until (TryAgain = False);
CloseZip;
{$IFNDEF KPSMALL}
Screen.Cursor := crDefault;
{$ENDIF}
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -