📄 vclzip.pas
字号:
function FilesListMatches(FName: String): Boolean;
var
tmpFName: String;
begin
if (OEMConvert) then
OemFilter(Fname);
tmpFName := LowerCase(FName);
If (Deleting) and (IsWildCard( FName )) then
begin { Wildcards should only be there if deleting }
If (Pos('\',FName) > 0) then
Result := IsMatch(tmpFName,LowerCase(tmpfile_info.directory+tmpfile_info.filename))
Else
Result := IsMatch(tmpFName,LowerCase(tmpfile_info.filename));
end
Else
begin
If not Deleting then
begin
tmpFName := ComparePath(tmpFName) + ExtractFilename(tmpFName);
end;
Result := tmpFName = LowerCase(tmpfile_info.directory+tmpfile_info.filename);
end;
end;
var
i,j: Integer;
MoveTheFile: Boolean;
Skip, aMatch: Boolean;
begin
If files = nil then { 3/28/98 2.1 }
exit; { fixed GPF when adding to empty archive }
For i := 0 to files.Count-1 do { Check each file in existing zip }
begin
tmpfile_info := CreateNewZipHeader;
tmpfile_info.Assign(files.Items[i] as TZipHeaderInfo);
if ((i = 0) and (tmpfile_info.relative_offset > 0) and (FPreserveStubs)) then
begin { save sfx stub from beginning of file }
theZipFile.Seek(0,soFromBeginning);
zfile.CopyFrom(theZipFile, tmpfile_info.relative_offset);
end;
if (tmpfile_info.FileIsOK = 2) then { skip files that are corrupted }
begin
tmpfile_info.Free;
continue;
end;
If (tmpfile_info.file_comment_length > 0) and (tmpfile_info.filecomment = nil) then
tmpfile_info.filecomment := StrToPChar(FileComment[i]);
MoveTheFile := True;
aMatch := False;
If (Deleting) and (tmpfile_info.Selected) then
begin
aMatch := True;
Skip := False;
tmpfile_info.Selected := False;
if (assigned(FOnDeleteEntry)) then
FOnDeleteEntry(Self, tmpfile_info.directory+tmpfile_info.filename, Skip );
if (not Skip) then
begin
Inc(Result);
MoveTheFile := False;
end;
end
else If (FilesList.Count > 0) then
For j := 0 to FilesList.Count-1 do { Compare to each file in FilesList }
begin
If (FilesListMatches(FilesList[j])) then
begin { This file is in zip file and fileslist too }
aMatch := True;
If (StreamZipping) or (MemZipping) or (ZipAction = zaReplace) or
(Deleting) or (((ZipAction = zaUpdate) or (ZipAction = zaFreshen))
and (DateTime[i] < FileDate(FilesList[j]))) then
begin { Don't move files that will be replaced }
Skip := False;
If (Deleting) and (Assigned(FOnDeleteEntry)) then
FOnDeleteEntry(Self, tmpfile_info.directory+tmpfile_info.filename, Skip );
If (Deleting) and (not Skip) then
Inc(Result); { 5/18/98 2.13 }
If not Skip then
begin
MoveTheFile := False; { or deleted. }
If (Deleting) and (not IsWildcard(FilesList[j])) then
FilesList.Delete(j); { We're deleting, not zipping }
If (not Deleting) then
begin
tmpfile_info.Free;
tmpfile_info := CreateNewZipHeader;
If Assigned(FOnUpdate) then
FOnUpdate( self, uaReplacing, i );
try
If AddFileToZip(FilesList[j]) then
AddTheNewFile(j)
Else
begin
tmpfile_info.Free;
tmpfile_info := nil;
end;
except
tmpfile_info.Free;
tmpfile_info := nil;
raise;
end;
FilesList.Delete(j);
end;
end
Else
begin
MoveTheFile := True; { File should just be saved from current zip }
FilesList.Delete(j); { because current file is not older }
end;
end
Else
begin
If Dispose then { 11/23/00 2.21b4+ }
DisposeFiles.Add(FilesList[j]); { Dispose of original file anyway }
MoveTheFile := True; { File should just be saved from current zip }
FilesList.Delete(j); { because disk file is not newer }
end;
Break;
end;
end;
If MoveTheFile then { Save this old file into new zip }
begin
If (aMatch) and (Assigned(FOnUpdate)) then
FOnUpdate( self, uaKeeping, i );
MoveFile(i);
tmpfiles.AddObject( tmpfile_info ); { Add info to new stuff }
tmpfiles2.AddObject( tmpfile_info );
tmpecrec.num_entries := tmpecrec.num_entries + 1;
tmpecrec.num_entries_this_disk := tmpecrec.num_entries_this_disk + 1;
end
Else
If (Deleting) then
tmpfile_info.Free
end;
tmpfile_info := nil;
end;
Procedure ExpandForWildCards;
var
i: Integer;
WildFiles: TStrings;
DirSearch: TDirSearch;
theFile, StartDir: String;
SearchRec: TSearchRec;
tmpsearchinfo: TZipHeaderInfo;
tmpWildCard: String;
Idx: Integer;
IsAnEntry: Boolean;
doRecurse: Boolean;
tmpWildFile: String;
tmpName: String;
begin
WildFiles := TStringList.Create;
TotalUncompressedSize := 0;
TotalBytesDone := 0;
i := 0;
If ZipAction = zaFreshen then
Sort( ByName ); { so we can check FilesList agains whats there already }
While (FilesList.Count > 0) and (i < FilesList.Count) do
begin
If (FilesList[i][Length(FilesList[i])] = '\') then
begin
Inc(i);
continue; { To explicitly add a plain directory entry 6/9/99 2.18+ }
end;
If IsWildcard(FilesList[i]) then
begin
WildFiles.Add( FilesList[i] );
FilesList.Delete(i);
end
Else
begin { See if file exists }
If ExtractFilePath(FilesList[i]) = '' then
FilesList[i] := FRootDir + FilesList[i];
If IsInExcludeList(FilesList[i]) then { 9/28/98 2.15 }
begin
FilesList.Delete(i);
Continue;
end;
If FindFirst( FilesList[i], faAnyFile, SearchRec ) = 0 then
begin
If ((FSkipIfArchiveBitNotSet) and ((FileGetAttr(FilesList[i]) and faArchive)=0)) then
begin
FilesList.Delete(i);
Continue; { Skip if only zipping files with archive bit set }
end;
If ZipAction = zaFreshen then
begin
{ Ignore it if it's not already in the zip }
tmpName := FilesList[i];
if (OEMConvert) then
OemFilter( tmpName );
tmpsearchinfo := CreateNewZipHeader;
tmpsearchinfo.filename := ExtractFilename(tmpName);
tmpsearchinfo.directory := ComparePath(tmpName);
IsAnEntry := sortfiles.Search( Pointer(tmpsearchinfo), Idx );
tmpsearchinfo.Free;
If not IsAnEntry then { Delete this entry from fileslist }
begin
FilesList.Delete(i);
Continue; { Skip if freshening and file's not in zip already }
end;
end;
TotalUncompressedSize := TotalUncompressedSize + SearchRec.Size;
Inc(i);
FindClose( SearchRec ); {1/28/98 moved inside here so wouldn't be called if}
end {FindFirst didn't find anything v2.00+}
Else
begin
If Assigned( FOnNoSuchFile ) then
OnNoSuchFile( Self, FilesList[i] );
{ Moved following line down 1 to fix 'List out of bounds' error. 5/5/98 2.12 }
FilesList.Delete(i); { No such file to zip }
end;
end;
end;
If WildFiles.Count > 0 then
For i := 0 to WildFiles.Count-1 do
begin
{ Added recursion override feature 7/22/98 2.14 }
If (WildFiles[i][1] = WILDCARD_NORECURSE) then { No recursing }
begin
doRecurse := False;
tmpWildFile := WildFiles[i];
Delete(tmpWildFile,1,1);
WildFiles[i] := tmpWildFile;
end
Else If (WildFiles[i][1] = WILDCARD_RECURSE) then { Recurse }
begin
doRecurse := True;
tmpWildFile := WildFiles[i];
Delete(tmpWildFile,1,1);
WildFiles[i] := tmpWildFile;
end
Else doRecurse := FRecurse;
StartDir := ExtractFileDir(WildFiles[i]);
If StartDir = '' then
StartDir := FRootDir;
{ Added check for not IsWildCard because it was stopping the use
of wildcards in paths. 8/22/01 2.22+ }
If (not IsWildCard(StartDir)) and (not DirExists(StartDir)) then { 10/23/98 2.16+ }
continue;
tmpWildCard := ExtractFilename(WildFiles[i]);
{ Convert *.* to * so that it will get all files in
TDirSearch }
if (tmpWildCard = '*.*') then { 7/9/01 2.21+ }
tmpWildCard := '*';
DirSearch := TDirSearch.Create( StartDir, tmpWildCard, doRecurse );
theFile := DirSearch.NextFile(SearchRec);
While (theFile <> '') do
begin
If (Assigned(FOnRecursingFile)) then
FOnRecursingFile(Self, theFile);
If (theFile[Length(theFile)] = '\') then
begin
If (doRecurse) and (FAddDirEntries) then
FilesList.Add( theFile );
theFile := DirSearch.NextFile(SearchRec);
Continue;
end;
If IsInExcludeList(theFile) then { 9/28/98 2.15 }
begin
theFile := DirSearch.NextFile(SearchRec);
Continue;
end;
If (DoProcessMessages) 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;
{Don't archive the archive we are creating right now}
If (ArchiveIsStream) or (AnsiCompareText(theFile,ZipName) <> 0) then
begin
If ((FSkipIfArchiveBitNotSet) and ((FileGetAttr(theFile) and faArchive)=0)) then
begin
theFile := DirSearch.NextFile(SearchRec);
Continue; { Skip if only zipping files with archive bit set }
end;
If ZipAction = zaFreshen then { skip if its not already in zip file }
begin
{ Ignore it if it's not already in the zip }
tmpName := theFile;
if (OEMConvert) then
OemFilter( tmpName );
tmpsearchinfo := CreateNewZipHeader;
tmpsearchinfo.filename := ExtractFilename(tmpName);
tmpsearchinfo.directory := ComparePath(tmpName);
IsAnEntry := sortfiles.Search( Pointer(tmpsearchinfo), Idx );
tmpsearchinfo.Free;
If not IsAnEntry then
begin
theFile := DirSearch.NextFile(SearchRec);
Continue; { Skip if freshening and file's not in zip already }
end;
end;
FilesList.Add( theFile );
TotalUncompressedSize := TotalUncompressedSize + SearchRec.Size;
end;
theFile := DirSearch.NextFile(SearchRec);
end;
DirSearch.Free;
end;
WildFiles.Free;
If ZipAction = zaFreshen then
Sort( ByNone ); { Set back }
end;
procedure AllocateZipArrays;
begin
{$IFDEF WIN16}
If windowObj = nil then
begin
windowObj := TkpHugeByteArray.Create(2*WSIZE);
window := windowtypePtr(windowObj.AddrOf[0]);
prevObj := TkpHugeWordArray.Create(WSIZE);
prev := prevtypePtr(prevObj.AddrOf[0]);
headObj := TkpHugeWordArray.Create(HASH_SIZE);
head := headtypePtr(headObj.AddrOf[0]);
l_bufObj := TkpHugeByteArray.Create(LIT_BUFSIZE);
l_buf := l_buftypePtr(l_bufObj.AddrOf[0]);
d_bufObj := TkpHugeWordArray.Create(DIST_BUFSIZE);
d_buf := d_buftypePtr(d_bufObj.AddrOf[0]);
flag_bufObj := TkpHugeByteArray.Create(LIT_BUFSIZE div 8);
flag_buf := flag_buftypePtr(flag_bufObj.AddrOf[0]);
end;
{$ELSE}
If window = nil then
begin
New(window);
New(prev);
New(head);
New(l_buf);
New(d_buf);
New(flag_buf);
end;
{$ENDIF}
end;
procedure DeAllocateZipArrays;
begin
{$IFDEF WIN16}
windowObj.Free;
windowObj := nil;
prevObj.Free;
prevObj := nil;
headObj.Free;
headObj := nil;
l_bufObj.Free;
l_bufObj := nil;
d_bufObj.Free;
d_bufObj := nil;
flag_bufObj.Free;
flag_bufObj := nil;
{$ELSE}
System.Dispose(window);
window := nil;
System.Dispose(prev);
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -