FIX: Bug [0001987] Deleting a file from the root of a zip archive (default wcx plugin) deletes all files with the same name from all subdirectories

This commit is contained in:
Alexander Koblov 2018-02-04 09:33:21 +00:00
commit ea4b783167
2 changed files with 55 additions and 22 deletions

View file

@ -63,6 +63,14 @@ type
TAbZipKit = class(TAbCustomZipKit)
public
{en
Delete one file from archive
}
procedure DeleteFile(const aFileName : String);
{en
Get the normalized file name
}
function GetFileName(aFileIndex: Integer): String;
{en
Delete directory entry and all file and directory entries matching
the same path recursively
@ -90,7 +98,7 @@ function AbExtractEntry(const Entries : String; var StartPos : Integer) : String
implementation
uses
AbExcept;
AbExcept, DCStrUtils;
{ TAbArchiveItemHelper }
@ -130,6 +138,50 @@ end;
{ TAbZipKit }
procedure TAbZipKit.DeleteFile(const aFileName: String);
var
I : Integer;
CompareName: function(const S1, S2: String): Integer;
begin
TAbArchiveAccess(Archive).CheckValid;
if ArchiveType in [atZip, atSpannedZip, atSelfExtZip] then
CompareName:= @CompareText
else begin
CompareName:= @CompareStr;
end;
if Count > 0 then
begin
for I := Pred(Count) downto 0 do
begin
with Archive.ItemList[I] do
begin
if CompareName(GetFileName(I), aFileName) = 0 then
begin
DeleteAt(I);
Break;
end;
end;
end;
end;
end;
function TAbZipKit.GetFileName(aFileIndex: Integer): String;
begin
Result := Items[aFileIndex].FileName;
if (ArchiveType in [atGzip, atGzippedTar]) and (Result = 'unknown') then
begin
Result := ExtractOnlyFileName(FileName);
if (ArchiveType = atGzippedTar) then
begin
if (TarAutoHandle = False) and (ExtractOnlyFileExt(Result) <> 'tar') then
Result := Result + '.tar';
end;
end;
DoDirSeparators(Result);
Result := ExcludeFrontPathDelimiter(Result);
Result := ExcludeTrailingPathDelimiter(Result);
end;
procedure TAbZipKit.DeleteDirectoriesRecursively(const Paths: String);
var
I : Integer;

View file

@ -50,8 +50,6 @@ type
ErrorClass: TAbErrorClass; ErrorCode: Integer);
public
constructor Create(AOwner: TComponent); override;
function GetFileName(aFileIndex: Integer): String;
end;
{Mandatory functions}
@ -87,7 +85,7 @@ var
implementation
uses
SysUtils, LazUTF8, ZipConfDlg, AbBrowse, DCOSUtils, DCStrUtils, DCConvertEncoding;
SysUtils, LazUTF8, ZipConfDlg, AbBrowse, DCConvertEncoding;
threadvar
gProcessDataProcW : TProcessDataProcW;
@ -412,7 +410,7 @@ begin
then
Arc.DeleteDirectoriesRecursively(ExtractFilePath(FileNameUTF8))
else
Arc.DeleteFiles(FileNameUTF8);
Arc.DeleteFile(FileNameUTF8);
pFileName := pFileName + Length(FileName) + 1; // move after filename and ending #0
if pFileName^ = #0 then
@ -471,23 +469,6 @@ begin
TempDirectory := GetTempDir;
end;
function TAbZipKitEx.GetFileName(aFileIndex: Integer): String;
begin
Result := Items[aFileIndex].FileName;
if (ArchiveType in [atGzip, atGzippedTar]) and (Result = 'unknown') then
begin
Result := ExtractOnlyFileName(FileName);
if (ArchiveType = atGzippedTar) then
begin
if (TarAutoHandle = False) and (ExtractOnlyFileExt(Result) <> 'tar') then
Result := Result + '.tar';
end;
end;
DoDirSeparators(Result);
Result := ExcludeFrontPathDelimiter(Result);
Result := ExcludeTrailingPathDelimiter(Result);
end;
procedure TAbZipKitEx.AbProcessItemFailureEvent(Sender: TObject;
Item: TAbArchiveItem; ProcessType: TAbProcessType;
ErrorClass: TAbErrorClass; ErrorCode: Integer);