?? vclzip.pas
字號:
{ Either ZipName or ArchiveStream should be set }
if ((Trim(ZipName)='') and (ArchiveStream = nil)) then { 09/07/99 2.18+ }
exit;
FBusy := True;
FinishedOK := False;
CurrentDisk := 0;
SaveSortedFiles := sortfiles;
SaveSortMode := SortMode;
SaveKeepZipOpen := KeepZipOpen;
KeepZipOpen := True;
sortfiles := files;
SortMode := ByNone;
If Dispose then
DisposeFiles := TStringList.Create;
If (not Deleting) and (not StreamZipping) and (not MemZipping) and (FilesList.Count > 0) then
ExpandForWildCards;
{ Guesstimate space needed for the Zip Configuration File that will go on first disk of
a spanned zip file if SaveZipInfoOnFirstDisk is True }
If (MultiZipInfo.MultiMode <> mmNone) and (MultiZipInfo.SaveZipInfoOnFirstDisk) then
begin
If StorePaths then
tIncludePaths := 25 { Change this number to assume different average path length }
Else
tIncludePaths := 0;
{ We'll pad a little extra because comments aren't figured in and we want to make sure
we allow for sector's being allocated on disk }
MultiZipInfo.SaveOnFirstDisk :=
MultiZipInfo.SaveOnFirstDisk +
(FilesList.Count * (SizeOf(central_file_header)+12+tIncludePaths) ) +
SizeOf(end_of_central) + ecrec.zip_comment_length + 2048; { + 2048 for some padding }
end;
If MultiZipInfo.MultiMode = mmSpan then
AmountToWrite := DiskRoom - MultiZipInfo.SaveOnFirstDisk
Else If MultiZipInfo.MultiMode = mmBlocks then
AmountToWrite := MultiZipInfo.FirstBlockSize;
try { Moved up to here 4/12/98 2.11 }
If ((ArchiveIsStream) and (Count > 0))
or ((File_Exists(ZipName)) and (MultiZipInfo.MultiMode = mmNone)) then
begin { Added Multimode check 06/11/00 2.21b3+ }
AllocateZipArrays;
{ create new file in temporary directory }
UsingTempFile := True;
If not ArchiveIsStream then
begin
{PathSize := GetTempPath( SizeOf(tempPathPStr), @tempPathPStr[0] );}
{ Changed to TempFilename 5/5/98 2.12 }
tmpZipName := TempFilename(TemporaryPath);
{tmpZipName := StrPas(tempPathPStr) + ExtractFileName( ZipName );}
end;
CreateTempZip;
OpenZip; { open existing zip so we can move existing files }
MoveExistingFiles; {Move those existing files}
end
Else
begin
AllocateZipArrays;
If not ArchiveIsStream then
tmpZipName := ZipName;
UsingTempFile := False;
CreateTempZip;
end;
If (not Deleting) and (FilesList.Count > 0) then
begin
StopNow := False;
If Assigned(FOnStartZipInfo) then
FOnStartZipInfo( Self, FilesList.Count, TotalUncompressedSize, tmpecrec, StopNow );
If StopNow then
{$IFDEF NO_RES}
raise EUserCanceled.Create('User canceled Zip operation.');
{$ELSE}
raise EUserCanceled.Create(LoadStr(IDS_CANCELZIPOPERATION));
{$ENDIF}
end;
If MultiZipInfo.MultiMode <> mmNone then
TotalUncompressedSize := TotalUnCompressedSize * 2;
{ For each file in the FilesList AddFileToZip }
If (not Deleting) and (FilesList.Count > 0) then
begin
For i := 0 to FilesList.Count-1 do
begin
tmpfile_info := TZipHeaderInfo.Create;
try
If AddFileToZip(FilesList[i]) then
AddTheNewFile(i)
Else
begin
tmpfile_info.Free;
tmpfile_info := nil;
end;
except
tmpfile_info.Free;
tmpfile_info := nil;
raise;
end;
end;
end; { If not Deleting }
tmpecrec.offset_central := zfile.Position;
tmpecrec.start_central_disk := CurrentDisk;
totalCentralSize := 0;
saveCentralPos := tmpecrec.offset_central;
For i := 0 to tmpfiles2.Count-1 do
begin
tmpfile_info := tmpfiles2.Items[i] as TZipHeaderInfo;
If (MultiZipInfo.MultiMode <> mmNone) and (RoomLeft < tmpfile_info.CentralSize) then
begin
Inc(TotalCentralSize,zfile.Position - saveCentralPos);
saveCentralPos := 0;
NextPart;
If i = 0 then
begin
tmpecrec.offset_central := 0;
tmpecrec.start_central_disk := CurrentDisk;
end;
end;
tmpfile_info.SaveCentralToStream( zfile );
end;
Inc(TotalCentralSize,zfile.Position - saveCentralPos);
tmpecrec.size_central := TotalCentralSize;
If (MultiZipInfo.MultiMode <> mmNone) and (RoomLeft < tmpecrec.EndCentralSize) then
NextPart;
tmpecrec.this_disk := CurrentDisk;
tmpecrec.SaveToStream(zfile);
If MultiZipInfo.MultiMode = mmSpan then
LabelDisk;
FinishedOK := True;
finally
DeAllocateZipArrays;
If (not ArchiveIsStream) then
begin
zfile.Free; { close the temp zip file }
zfile := nil;
end;
If FinishedOK then
begin
If (not ArchiveIsStream) and (not CreatingSFX) then
SaveZipName := ZipName;
If (not CreatingSFX) and ((not ArchiveIsStream) and (UsingTempFile)) then
ClearZip;
If (MultiZipInfo.MultiMode = mmBlocks) then
begin
If (CurrentDisk > 0) then
ZipName := ChangeFileExt(SaveZipName,'.'+Format('%3.3d',[CurrentDisk+1]))
Else
begin { No need for the multi file extention so change back to .zip }
ZipName := SaveZipName;
SaveZipName := ChangeFileExt(SaveZipName,'.'+Format('%3.3d',[CurrentDisk+1]));
RenameFile(SaveZipName, ZipName);
end;
end
Else If (not ArchiveIsStream) and (not CreatingSFX) then
ZipName := SaveZipName;
If (UsingTempFile) then
MoveTempFile
Else If ArchiveIsStream then
zfile := nil; {2/11/98}
If (Dispose) then
DisposeOfFiles;
If not CreatingSFX then
begin { We'll point everyting to the newly created information }
ecrec.Assign( tmpecrec );
files := tmpfiles2;
sortfiles := files;
SortMode := ByNone;
end
Else { We're going back to the same zip file }
begin
tmpfiles2.Free;
tmpfiles2 := nil;
sortfiles := SaveSortedFiles;
end;
If (not ArchiveIsStream) and (not CreatingSFX) then
filesDate := FileDate( ZipName );
If (SaveSortMode <> ByName) and (not CreatingSFX) then
Sort(SaveSortMode)
Else If (not CreatingSFX) then
begin
sortfiles := tmpfiles; { already sorted by name }
tmpfiles := nil;
end;
WriteNumDisks( CurrentDisk+1 );
If (MultiZipInfo.MultiMode <> mmNone) and (Assigned(FOnTotalPercentDone)) then
OnTotalPercentDone(self, 100); { To be sure. 5/23/99 2.18+}
If (MultiZipInfo.MultiMode <> mmNone) and (MultiZipInfo.SaveZipInfoOnFirstDisk)
and (ecrec.this_disk > 0) then
begin
If MultiZipInfo.MultiMode = mmSpan then
begin
AskForNewDisk(1); { Ask for 1st disk }
{$IFNDEF KPSMALL}
Screen.Cursor := crHourGlass;
{$ENDIF}
end;
SaveZipInfoToFile(ChangeFileExt(ZipName,'.zfc'));
{$IFNDEF KPSMALL}
If MultiZipInfo.MultiMode = mmSpan then
Screen.Cursor := crDefault;
{$ENDIF}
end;
end
Else
begin
tmpfiles2.Free;
tmpfiles2 := nil;
SysUtils.DeleteFile( tmpZipName );
end;
SortMode := SaveSortMode;
KeepZipOpen := SaveKeepZipOpen;
tmpfiles.Free;
tmpfiles := nil;
tmpecrec.Free;
tmpecrec := nil;
CloseZip;
If ArchiveIsStream then
GetFileInfo(theZipFile);
FBusy := False;
FilesList.Clear; { 6/27/99 2.18+ }
end;
end;
procedure TVCLZip.CreateTempZip;
begin
If MultiZipInfo.MultiMode = mmBlocks then
tmpZipName := ChangeFileExt(tmpZipName,'.'+Format('%3.3d',[CurrentDisk+1]));
If not ArchiveIsStream then
zfile := TLFNFileStream.CreateFile( tmpZipName, fmCreate, FFlushFilesOnClose, BufferedStreamSize )
Else
begin
If UsingTempFile then
zfile := TMemoryStream.Create
Else
zfile := theZipFile; {2/11/98}
end;
If CreatingSFX then
zfile.CopyFrom( SFXStubFile, SFXStubFile.Size );
tmpfiles := TSortedZip.Create( DupError );
tmpfiles.SortMode := ByName;
tmpfiles.DestroyObjects := False;
tmpfiles2 := TSortedZip.Create( DupError );
tmpfiles2.SortMode := ByNone;
tmpecrec := TEndCentral.Create;
If (UsingTempFile) or (ecrec.Modified) then
begin
tmpecrec.Assign( ecrec );
If (tmpecrec.zip_comment_length > 0) and (tmpecrec.ZipComment = nil) then
tmpecrec.ZipComment := StrToPChar(ZipComment);
tmpecrec.num_entries := 0;
tmpecrec.num_entries_this_disk := 0;
tmpecrec.Modified := False;
end;
end;
function TVCLZip.DiskRoom: BIGINT;
var
Disk: Byte;
begin
If ZipName[2] <> ':' then
Disk := 0
Else
begin
Disk := Ord(ZipName[1])-64;
If Disk > 32 then
Dec(Disk,32);
end;
Result := DiskFree(Disk);
end;
function TVCLZip.RoomLeft: BIGINT;
begin
Result := AmountToWrite - zfile.Size;
end;
procedure TVCLZip.LabelDisk;
var
Disk: String;
NewLabel: String;
{Rslt: LongBool;}
begin
If (MultiZipInfo.MultiMode = mmSpan) and (MultiZipInfo.WriteDiskLabels) then
begin
Disk := ZipName[1];
Disk := UpperCase(Disk);
If (Disk = 'A') or (Disk = 'B') then { Only label floppies }
begin
Disk := Disk + ':\';
NewLabel := 'PKBACK# ' + Format('%3.3d',[CurrentDisk+1]);
{Rslt :=} SetVolLabel(Disk, NewLabel);
end;
end;
end;
procedure TVCLZip.NextPart;
begin
If MultiZipInfo.MultiMode <> mmNone then
begin
If MultiZipInfo.MultiMode = mmSpan then
begin
If Assigned(FOnGetNextDisk) then
begin
zfile.Free;
zfile := nil;
LabelDisk; { Label disk before they change it }
OnGetNextDisk(Self, CurrentDisk+2, tmpZipName);
If tmpZipName = '' then
{$IFDEF NO_RES}
raise EUserCanceled.Create('User canceled Zip operation.');
{$ELSE}
raise EUserCanceled.Create(LoadStr(IDS_CANCELZIPOPERATION));
{$ENDIF}
Inc(CurrentDisk);
if FileExists(tmpZipName) then
SysUtils.DeleteFile(tmpZipName); { 10/19/99 2.20b3+ }
if Assigned(FOnPrepareNextDisk) then
FOnPrepareNextDisk( self, CurrentDisk+1 );
AmountToWrite := DiskRoom;
end
end
Else
begin
zfile.Free;
zfile := nil;
Inc(CurrentDisk);
tmpZipName := ChangeFileExt(tmpZipName, '.'+Format('%3.3d',[CurrentDisk+1]));
AmountToWrite := MultiZipInfo.BlockSize;
end;
zfile := TLFNFileStream.CreateFile( tmpZipName, fmCreate, FFlushFilesOnClose, BufferedStreamSize );
AmountWritten := 0;
tmpecrec.num_entries_this_disk := 0;
end;
end;
function TVCLZip.AddFileToZip( FName: String ): Boolean;
var
SavePos: LongInt;
tmpDir: String;
Idx: Integer;
Skip: Boolean;
{tempPathPStr: array [0..PATH_LEN] of char;}
{PathSize: LongInt;}
procedure CalcFileCRC;
{ Modified to use a PChar for cbuffer 4/12/98 2.11 }
const
{BLKSIZ = OUTBUFSIZ;}
BLKSIZ = DEF_BUFSTREAMSIZE;
var
cbuffer: PChar;
AmountRead: LongInt;
AmtLeft: LongInt;
begin
AmtLeft := 0;
cbuffer := nil;
If (not MemZipping) then
GetMem(cbuffer,BLKSIZ);
try
Crc32Val := $FFFFFFFF;
If (MemZipping) then
begin
cbuffer := MemBuffer;
AmountRead := kpmin(MemLen,BLKSIZ);
AmtLeft := MemLen - AmountRead;
end
Else
AmountRead := IFile.Read(cbuffer^, BLKSIZ);
While AmountRead <> 0 do
begin
Update_CRC_buff(BytePtr(cbuffer), AmountRead);
If (MemZipping) then
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -