📄 vclzip.pas
字号:
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
begin
Inc(cbuffer, AmountRead);
AmountRead := kpmin(AmtLeft, BLKSIZ);
{ Inc(cbuffer, AmountRead); } { Moved up 2 lines 5/15/00 2.20++ }
Dec(AmtLeft, AmountRead);
end
Else
AmountRead := IFile.Read(cbuffer^, BLKSIZ);
end;
If (not MemZipping) then
IFile.Seek(0, soFromBeginning);
finally
If (not MemZipping) then
FreeMem(cbuffer,BLKSIZ);
end;
end;
procedure SaveMFile;
var
AmtToCopy: LongInt;
TotalAmtToCopy: LongInt;
progressAmt: LongInt;
progressDone: LongInt;
progressPartition: LongInt;
Percent: LongInt;
const
SPAN_BUFFER_SIZE = $4000;
begin
progressDone := 0;
progressAmt := 0;
If RoomLeft <= 0 then { changed to <= 05/23/00 2.21PR2+ }
NextPart;
If Assigned(FOnFilePercentDone) then
begin
progressAmt := tmpfile_info.uncompressed_size + mfile.Size;
progressDone := tmpfile_info.uncompressed_size;
end;
If Assigned(FOnTotalPercentDone) then {Need to adjust for the diff since guessed}
TotalUnCompressedSize := TotalUnCompressedSize-(tmpfile_info.uncompressed_size-mfile.Size);
mfile.Seek(0, soFromBeginning);
TotalAmtToCopy := mfile.Size;
AmtToCopy := kpmin( RoomLeft, TotalAmtToCopy );
If (mfile.Size = 0) then
AmtToCopy := 0;
While (TotalAmtToCopy > 0) and (AmtToCopy > 0) do
begin
Dec(TotalAmtToCopy,AmtToCopy);
If Assigned(FOnFilePercentDone) or Assigned(FOnTotalPercentDone) then
begin
While (AmtToCopy > 0) do
begin
progressPartition := kpmin(SPAN_BUFFER_SIZE, AmtToCopy);
zfile.CopyFrom( mfile, progressPartition );
Inc(progressDone, progressPartition);
If Assigned(FOnFilePercentDone) then
begin
Percent := CRate( progressAmt, progressDone );
OnFilePercentDone( self, Percent );
end;
If Assigned(FOnTotalPercentDone) then
begin
TotalBytesDone := TotalBytesDone + progressPartition;
Percent := CBigRate( TotalUncompressedSize, TotalBytesDone );
OnTotalPercentDone( self, Percent );
end;
Dec(AmtToCopy,progressPartition);
end;
end
Else
zfile.CopyFrom( mfile, AmtToCopy );
If (TotalAmtToCopy > 0) or (RoomLeft <= 0) then
NextPart;
AmtToCopy := kpmin( RoomLeft, TotalAmtToCopy );
end;
end;
procedure StoreFile;
const
BLKSIZ = OUTBUFSIZ;
var
storeBuf: BytePtr;
bytesRead: LongInt;
begin
GetMem(storeBuf, BLKSIZ);
try
bytesRead := file_read(storeBuf,BLKSIZ);
While bytesRead > 0 do
begin
zfwrite(storeBuf,1,bytesRead);
bytesRead := file_read(storeBuf,BLKSIZ);
end;
finally
FreeMem(storeBuf,BLKSIZ);
end;
end;
var
tmpRootDir: String;
DrivePart: String;
IsDir: Boolean;
tmpDirName: String;
SearchRec: TSearchRec;
Retry: Boolean;
begin { ************* AddFileToZip Procedure ***************** }
Result := False;
FileBytes := 0;
IFileName := FName;
tmpRootDir := RootDir; { 5/3/98 2.12 }
If FName[Length(FName)] = '\' then
IsDir := True
Else
IsDir := False;
If IsDir then
begin
If (StreamZipping) or (MemZipping) or (not DirExists(FName)) then
tmpfile_info.last_mod_file_date_time := DateTimeToFileDate( Now )
Else
begin
tmpDirName := Copy(FName,1,Length(FName)-1);
If FindFirst( tmpDirName, faAnyFile, SearchRec ) = 0 then
begin tmpfile_info.last_mod_file_date_time := SearchRec.Time; FindClose(SearchRec); { 09/14/01 2.22+ } end Else
tmpfile_info.last_mod_file_date_time := DateTimeToFileDate( Now );
end;
tmpfile_info.uncompressed_size := 0;
tmpfile_info.compressed_size := 0;
tmpfile_info.compression_method := STORED;
tmpfile_info.internal_file_attributes := BINARY; { assume binary if STOREing - for now. 10/18/98 }
tmpfile_info.crc32 := 0;
If DirExists( FName ) then
tmpfile_info.external_file_attributes := FileGetAttr( FName );
end
Else If (not StreamZipping) and (not MemZipping) and (not IsDir) then
begin
If not FileExists( FName ) then
exit;
tmpfile_info.external_file_attributes := FileGetAttr( FName );
Retry := False;
Repeat
try
{IFile := TLFNFileStream.CreateFile( FName, fmOpenRead or fmShareDenyNone, False );}
IFile := TLFNFileStream.CreateFile( FName, fmOpenRead or FFileOpenMode, False, BufferedStreamSize );
Retry := False;
except
Retry := False;
If Assigned( FOnSkippingFile ) then
FOnSkippingFile( self, srFileOpenError, FName, -1, Retry );
If not Retry then
exit;
end;
Until (Retry = False);
tmpfile_info.last_mod_file_date_time := FileGetDate( TLFNFileStream(IFile).Handle );
end
Else
begin
If (StreamZipping) then
IFile := ZipStream;
tmpfile_info.last_mod_file_date_time := DateTimeToFileDate( Now );
end;
mfile := nil;
try
If (MemZipping) and (not IsDir) then
tmpfile_info.uncompressed_size := MemLen
Else If (not IsDir) then
tmpfile_info.uncompressed_size := IFile.Size;
{$IFDEF WIN32}
If FStore83Names then
begin
FName := LFN_ConvertLFName(FName,SHORTEN);
If tmpRootDir <> '' then
tmpRootDir := LFN_ConvertLFName(RootDir,SHORTEN);
end;
{$ELSE}
{$IFNDEF NOLONGNAMES} { 4/12/98 2.11 }
If (not FStore83Names) and (OSVersion > 3) then
begin
FName := LFN_ConvertLFName(FName,LENGTHEN);
If tmpRootDir <> '' then
tmpRootDir := LFN_ConvertLFName(RootDir,LENGTHEN);
end;
{$ENDIF}
{$ENDIF}
if (OEMConvert) then
OEMFilter(FName);
If (not IsDir) then
tmpfile_info.filename := ExtractFileName(FName)
Else
tmpfile_info.filename := '';
tmpfile_info.relative_offset := zfile.Position;
tmpfile_info.internal_file_attributes := UNKNOWN;
tmpfile_info.disk_number_start := CurrentDisk;
If FStorePaths then
begin
tmpDir := ExtractFileDir(Fname) + '\';
If RightStr( tmpDir, 2 ) = '\\' then {Incase it's the root directory 3/10/98 2.03}
SetLength(tmpDir, Length(tmpDir)-1);
If (tmpRootDir <> '') and (RelativePaths) and (AnsiCompareText(LeftStr(tmpDir,Length(tmpRootDir)),tmpRootDir)=0) then
begin
If (AnsiCompareText(tmpRootDir,tmpDir)=0) then
tmpDir := ''
Else
Delete( tmpDir, 1, Length(tmpRootDir));
end;
{ added the following 3/26/98 to handle UNC paths. 2.1 }
If {(not RelativePaths) and} (not FStoreVolumes) and (tmpDir <> '') then
begin
DrivePart := ExtractFileDrive(tmpdir);
if DrivePart <> '' then
Delete(tmpdir, 1, Length(DrivePart));
if LeftStr(tmpdir,1) = '\' then
Delete(tmpdir,1,1);
end;
tmpfile_info.directory := tmpDir;
{The filename_length now gets set automatically when setting the directory
or filename Nov 16, 1997 KLB }
{tmpfile_info.filename_length := Length(tmpfile_info.directory+tmpfile_info.filename);}
end;
{The filename_length now gets set automatically when setting the directory
or filename Nov 16, 1997 KLB }
{Else
tmpfile_info.filename_length := Length(tmpfile_info.filename);}
{ If a file by the same name is already archived then skip this one }
If tmpfiles.Search( Pointer(tmpfile_info), Idx ) then
begin
Result := False;
{ This is sort of a cludge but it works for now }
If Assigned( FOnSkippingFile ) then
begin
FOnSkippingFile( self, srNoOverwrite, FName, -1, Retry );
end;
If (not StreamZipping) and (not MemZipping) and (not IsDir) then
begin
TotalUncompressedSize := TotalUncompressedSize - IFile.Size;
IFile.Free;
IFile := nil;
end;
exit;
end;
Skip := False;
If Assigned( FOnStartZip ) then
FOnStartZip( Self, FName, tmpfile_info, Skip );
If Skip then
begin
If (not StreamZipping) and (not MemZipping) and (not IsDir) then
begin
TotalUncompressedSize := TotalUncompressedSize - IFile.Size;
IFile.Free;
IFile := nil;
end;
Result := False;
exit;
end;
{Save local header for now, will update when done}
If (MultiZipInfo.MultiMode <> mmNone) and (RoomLeft <= tmpfile_info.LocalSize) { and (not IsDir) } then
begin { 2/1/98 Changed the above from < to <= }
NextPart;
tmpfile_info.disk_number_start := CurrentDisk; { 2/1/98 }
tmpfile_info.relative_offset := 0; { Added 05/23/00 2.21PR2+ }
end;
If (MultiZipInfo.MultiMode <> mmNone) and (not IsDir) then
begin
{PathSize := GetTempPath( SizeOf(tempPathPStr), @tempPathPStr[0] );}
{ Changed to TempFilename 5/5/98 2.12 }
mZipName := TempFilename(TemporaryPath);
{mZipName := StrPas(tempPathPStr) + 'KPy76p09.tmp';}
mfile := TLFNFileStream.CreateFile( mZipName, fmCreate, FFlushFilesOnClose, BufferedStreamSize );
end
else { Added this else 2/5/00 2.20+ }
tmpfile_info.SaveLocalToStream( zfile );
{SavePos := zfile.Position;}
If (IsDir) then
begin
If Assigned(FOnEndZip) then
FOnEndZip( Self, FName, 0, 0, 0 );
Result := True;
exit;
end;
If (Password <> '') and (not IsDir) then
begin
CalcFileCRC;
Crc32Val := not Crc32Val;
tmpfile_info.crc32 := Crc32Val;
crypthead( Password );
end;
Crc32Val := $FFFFFFFF;
{$IFDEF KPDEMO}
If not DR then
tmpfile_info.filename := '';
{$ENDIF}
{*************** HERE IS THE CALL TO ZIP ************************}
If (PackLevel = 0) or (IsInNoCompressList(tmpfile_info.filename)) then { 10/23/98 2.16+ }
begin
StoreFile;
tmpfile_info.compressed_size := tmpfile_info.uncompressed_size;
tmpfile_info.compression_method := STORED;
tmpfile_info.internal_file_attributes := BINARY; { assume binary if STOREing - for now. 10/18/98 }
end
Else
tmpfile_info.compressed_size := Deflate; { Compress the file!! }
{****************************************************************}
{ Assert( tmpfile_info.compressed_size = zfile.Seek(0, soFromCurrent) - SavePos, }
{ 'Deflate returned wrong compressed size.'); }
Crc32Val := not Crc32Val;
SavePos := zfile.Position;
zfile.Seek(tmpfile_info.relative_offset, soFromBeginning);
tmpfile_info.crc32 := Crc32Val;
If Password <> '' then
begin { Mark the file as encrypted and modify compressed size
to take into account the 12 byte e⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -