paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 09:06:02 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fix bug ID #27158, allow use of UTF8 filenames.

Browse Source 
git-svn-id: trunk@33331 -
This commit is contained in:
michael 2016-03-26 13:42:57 +00:00
parent 73bf5dd3f0
commit 9cc2767854
2 changed files with 161 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
packages/paszlib/examples/fpunzipper.lpr
View File

@ -34,16 +34,20 @@ Var
F : TFileStream; F : TFileStream;
begin begin
If ParamCount<=1 then If ParamCount<1 then
begin begin
Writeln('Usage ',ParamStr(0),' zipfile file1 [file2 [...]]'); Writeln('Usage ',ParamStr(0),' zipfile [file1 [file2 [...]]]');
Terminate; Terminate;
exit; exit;
end; end;
FUnZipper.FileName:=ParamStr(1); FUnZipper.FileName:=ParamStr(1);
FUnZipper.UseUTF8:=True;
FUnZipper.Examine; FUnZipper.Examine;
For I:=2 to ParamCount do if ParamCount=1 then
FFiles.Add(ParamStr(I)); FUnZipper.UnZipAllFiles
else
For I:=2 to ParamCount do
FFiles.Add(ParamStr(I));
FUnZipper.UnZipFiles(FFiles); FUnZipper.UnZipFiles(FFiles);
Terminate; Terminate;
end; end;

177
packages/paszlib/src/zipper.pp
View File

@ -32,6 +32,8 @@ Const
LOCAL_FILE_HEADER_SIGNATURE = $04034B50; LOCAL_FILE_HEADER_SIGNATURE = $04034B50;
CENTRAL_FILE_HEADER_SIGNATURE = $02014B50; CENTRAL_FILE_HEADER_SIGNATURE = $02014B50;
ZIP64_HEADER_ID = $0001; ZIP64_HEADER_ID = $0001;
// infozip unicode path
INFOZIP_UNICODE_PATH_ID = $7075;
const const
OS_FAT = 0; //MS-DOS and OS/2 (FAT/VFAT/FAT32) OS_FAT = 0; //MS-DOS and OS/2 (FAT/VFAT/FAT32)
@ -339,6 +341,8 @@ Type
TZipFileEntry = Class(TCollectionItem) TZipFileEntry = Class(TCollectionItem)
private private
FArchiveFileName: String; //Name of the file as it appears in the zip file list FArchiveFileName: String; //Name of the file as it appears in the zip file list
FUTF8FileName : UTF8String;
FUTF8DiskFileName : UTF8String;
FAttributes: LongInt; FAttributes: LongInt;
FDateTime: TDateTime; FDateTime: TDateTime;
FDiskFileName: String; {Name of the file on disk (i.e. uncompressed. Can be empty if based on a stream.); FDiskFileName: String; {Name of the file on disk (i.e. uncompressed. Can be empty if based on a stream.);
@ -350,8 +354,12 @@ Type
FStream: TStream; FStream: TStream;
FCompressionLevel: TCompressionlevel; FCompressionLevel: TCompressionlevel;
function GetArchiveFileName: String; function GetArchiveFileName: String;
function GetUTF8ArchiveFileName: UTF8String;
function GetUTF8DiskFileName: UTF8String;
procedure SetArchiveFileName(Const AValue: String); procedure SetArchiveFileName(Const AValue: String);
procedure SetDiskFileName(Const AValue: String); procedure SetDiskFileName(Const AValue: String);
procedure SetUTF8ArchiveFileName(AValue: UTF8String);
procedure SetUTF8DiskFileName(AValue: UTF8String);
Protected Protected
// For multi-disk support, a disk number property could be added here. // For multi-disk support, a disk number property could be added here.
Property HdrPos : int64 Read FHeaderPos Write FheaderPos; Property HdrPos : int64 Read FHeaderPos Write FheaderPos;
@ -364,7 +372,9 @@ Type
Property Stream : TStream Read FStream Write FStream; Property Stream : TStream Read FStream Write FStream;
Published Published
Property ArchiveFileName : String Read GetArchiveFileName Write SetArchiveFileName; Property ArchiveFileName : String Read GetArchiveFileName Write SetArchiveFileName;
Property UTF8ArchiveFileName : UTF8String Read GetUTF8ArchiveFileName Write SetUTF8ArchiveFileName;
Property DiskFileName : String Read FDiskFileName Write SetDiskFileName; Property DiskFileName : String Read FDiskFileName Write SetDiskFileName;
Property UTF8DiskFileName : UTF8String Read GetUTF8DiskFileName Write SetUTF8DiskFileName;
Property Size : Int64 Read FSize Write FSize; Property Size : Int64 Read FSize Write FSize;
Property DateTime : TDateTime Read FDateTime Write FDateTime; Property DateTime : TDateTime Read FDateTime Write FDateTime;
property OS: Byte read FOS write FOS; property OS: Byte read FOS write FOS;
@ -496,6 +506,7 @@ Type
FFileComment: String; FFileComment: String;
FEntries : TFullZipFileEntries; FEntries : TFullZipFileEntries;
FFiles : TStrings; FFiles : TStrings;
FUseUTF8: Boolean;
FZipStream : TStream; { I/O file variables } FZipStream : TStream; { I/O file variables }
LocalHdr : Local_File_Header_Type; //Local header, before compressed file data LocalHdr : Local_File_Header_Type; //Local header, before compressed file data
LocalZip64Fld : Zip64_Extended_Info_Field_Type; //header is in LocalZip64ExtHdr LocalZip64Fld : Zip64_Extended_Info_Field_Type; //header is in LocalZip64ExtHdr
@ -518,7 +529,7 @@ Type
Procedure ReadZipHeader(Item : TFullZipFileEntry; out AMethod : Word); Procedure ReadZipHeader(Item : TFullZipFileEntry; out AMethod : Word);
Procedure DoEndOfFile; Procedure DoEndOfFile;
Procedure UnZipOneFile(Item : TFullZipFileEntry); virtual; Procedure UnZipOneFile(Item : TFullZipFileEntry); virtual;
Function OpenOutput(OutFileName : String; var OutStream: TStream; Item : TFullZipFileEntry) : Boolean; Function OpenOutput(OutFileName : RawByteString; var OutStream: TStream; Item : TFullZipFileEntry) : Boolean;
Procedure SetBufSize(Value : LongWord); Procedure SetBufSize(Value : LongWord);
Procedure SetFileName(Value : String); Procedure SetFileName(Value : String);
Procedure SetOutputPath(Value:String); Procedure SetOutputPath(Value:String);
@ -547,6 +558,7 @@ Type
Property FileComment: String Read FFileComment; Property FileComment: String Read FFileComment;
Property Files : TStrings Read FFiles; Property Files : TStrings Read FFiles;
Property Entries : TFullZipFileEntries Read FEntries; Property Entries : TFullZipFileEntries Read FEntries;
Property UseUTF8 : Boolean Read FUseUTF8 Write FUseUTF8;
end; end;
EZipError = Class(Exception); EZipError = Class(Exception);
@ -762,6 +774,17 @@ begin
Result := Result or UNIX_FILE; Result := Result or UNIX_FILE;
end; end;
function CRC32Str(const s:string):DWord;
var
i:Integer;
begin
Result:=$FFFFFFFF;
if Length(S)>0 then
for i:=1 to Length(s) do
Result:=Crc_32_Tab[Byte(Result XOR LongInt(s[i]))] XOR ((Result SHR 8) AND $00FFFFFF);
Result:=not Result;
end;
{ --------------------------------------------------------------------- { ---------------------------------------------------------------------
TDeCompressor TDeCompressor
---------------------------------------------------------------------} ---------------------------------------------------------------------}
@ -1953,7 +1976,7 @@ end;
TUnZipper TUnZipper
---------------------------------------------------------------------} ---------------------------------------------------------------------}
Procedure TUnZipper.OpenInput; procedure TUnZipper.OpenInput;
Begin Begin
if Assigned(FOnOpenInputStream) then if Assigned(FOnOpenInputStream) then
@ -1963,7 +1986,8 @@ Begin
End; End;
Function TUnZipper.OpenOutput(OutFileName : String; var OutStream: TStream; Item : TFullZipFileEntry) : Boolean; function TUnZipper.OpenOutput(OutFileName: RawByteString;
var OutStream: TStream; Item: TFullZipFileEntry): Boolean;
Var Var
Path: String; Path: String;
OldDirectorySeparators: set of char; OldDirectorySeparators: set of char;
@ -2010,7 +2034,8 @@ Begin
End; End;
Procedure TUnZipper.CloseOutput(Item : TFullZipFileEntry; var OutStream: TStream); procedure TUnZipper.CloseOutput(Item: TFullZipFileEntry; var OutStream: TStream
);
Begin Begin
if Assigned(FOnDoneStream) then if Assigned(FOnDoneStream) then
@ -2024,7 +2049,7 @@ Begin
end; end;
Procedure TUnZipper.CloseInput; procedure TUnZipper.CloseInput;
Begin Begin
if Assigned(FOnCloseInputStream) then if Assigned(FOnCloseInputStream) then
@ -2033,12 +2058,16 @@ Begin
end; end;
Procedure TUnZipper.ReadZipHeader(Item : TFullZipFileEntry; out AMethod : Word); procedure TUnZipper.ReadZipHeader(Item: TFullZipFileEntry; out AMethod: Word);
Var Var
S : String; S : String;
U : UTF8String;
D : TDateTime; D : TDateTime;
ExtraFieldHdr: Extensible_Data_Field_Header_Type; ExtraFieldHdr: Extensible_Data_Field_Header_Type;
SavePos: int64; //could be qword but limited by stream SavePos: int64; //could be qword but limited by stream
// Infozip unicode path
Infozip_Unicode_Path_Ver:Byte;
Infozip_Unicode_Path_CRC32:DWord;
Begin Begin
FZipStream.Seek(Item.HdrPos,soBeginning); FZipStream.Seek(Item.HdrPos,soBeginning);
FZipStream.ReadBuffer(LocalHdr,SizeOf(LocalHdr)); FZipStream.ReadBuffer(LocalHdr,SizeOf(LocalHdr));
@ -2057,7 +2086,7 @@ Begin
if Extra_Field_Length>0 then if Extra_Field_Length>0 then
begin begin
SavePos := FZipStream.Position; SavePos := FZipStream.Position;
if (LocalHdr.Extra_Field_Length>=SizeOf(ExtraFieldHdr)+SizeOf(LocalZip64Fld)) then if (LocalHdr.Extra_Field_Length>=SizeOf(ExtraFieldHdr)) then
while FZipStream.Position<SavePos+LocalHdr.Extra_Field_Length do while FZipStream.Position<SavePos+LocalHdr.Extra_Field_Length do
begin begin
FZipStream.ReadBuffer(ExtraFieldHdr, SizeOf(ExtraFieldHdr)); FZipStream.ReadBuffer(ExtraFieldHdr, SizeOf(ExtraFieldHdr));
@ -2070,7 +2099,32 @@ Begin
{$IFDEF FPC_BIG_ENDIAN} {$IFDEF FPC_BIG_ENDIAN}
LocalZip64Fld := SwapZ64EIF(LocalZip64Fld); LocalZip64Fld := SwapZ64EIF(LocalZip64Fld);
{$ENDIF} {$ENDIF}
end; end
// Infozip unicode path
else if ExtraFieldHdr.Header_ID=INFOZIP_UNICODE_PATH_ID then
begin
FZipStream.ReadBuffer(Infozip_Unicode_Path_Ver,1);
if Infozip_Unicode_Path_Ver=1 then
begin
FZipStream.ReadBuffer(Infozip_Unicode_Path_CRC32,sizeof(Infozip_Unicode_Path_CRC32));
{$IFDEF FPC_BIG_ENDIAN}
Infozip_Unicode_Path_CRC32:=SwapEndian(Infozip_Unicode_Path_CRC32);
{$ENDIF}
if CRC32Str(S)=Infozip_Unicode_Path_CRC32 then
begin
SetLength(U,ExtraFieldHdr.Data_Size-5);
FZipStream.ReadBuffer(U[1],Length(U));
Item.UTF8ArchiveFileName:=U;
Item.UTF8DiskFileName:=U;
end
else
FZipStream.Seek(ExtraFieldHdr.Data_Size-5,soFromCurrent);
end
else
FZipStream.Seek(ExtraFieldHdr.Data_Size-1,soFromCurrent);
end
else
FZipStream.Seek(ExtraFieldHdr.Data_Size,soFromCurrent);
end; end;
// Move past extra fields // Move past extra fields
FZipStream.Seek(SavePos+Extra_Field_Length,soFromBeginning); FZipStream.Seek(SavePos+Extra_Field_Length,soFromBeginning);
@ -2222,7 +2276,7 @@ begin
end; end;
end; end;
Procedure TUnZipper.ReadZipDirectory; procedure TUnZipper.ReadZipDirectory;
Var Var
EndHdr : End_of_Central_Dir_Type; EndHdr : End_of_Central_Dir_Type;
@ -2238,6 +2292,10 @@ Var
NewNode : TFullZipFileEntry; NewNode : TFullZipFileEntry;
D : TDateTime; D : TDateTime;
S : String; S : String;
U : UTF8String;
// infozip unicode path
Infozip_unicode_path_ver : byte; // always 1
Infozip_unicode_path_crc32 : DWord;
Begin Begin
FindEndHeaders(EndHdr, EndHdrPos, FindEndHeaders(EndHdr, EndHdrPos,
EndZip64Hdr, EndZip64HdrPos); EndZip64Hdr, EndZip64HdrPos);
@ -2329,6 +2387,28 @@ Begin
NewNode.HdrPos := Zip64Field.Relative_Hdr_Offset; NewNode.HdrPos := Zip64Field.Relative_Hdr_Offset;
end; end;
end end
// infozip unicode path extra field
else if ExtraFieldHeader.Header_ID = INFOZIP_UNICODE_PATH_ID then
begin
FZipStream.ReadBuffer(Infozip_unicode_path_ver,1);
if Infozip_unicode_path_ver=1 then
begin
FZipStream.ReadBuffer(Infozip_unicode_path_crc32,sizeof(Infozip_unicode_path_crc32));
{$IFDEF FPC_BIG_ENDIAN}
Infozip_unicode_path_crc32:=SwapEndian(Infozip_unicode_path_crc32);
{$ENDIF}
if CRC32Str(S)=Infozip_unicode_path_crc32 then
begin
SetLength(U,ExtraFieldHeader.Data_Size-5);
FZipStream.ReadBuffer(U[1],Length(U));
NewNode.UTF8ArchiveFileName:=U;
end
else
FZipStream.Seek(ExtraFieldHeader.Data_Size-5,soFromCurrent);
end
else
FZipStream.Seek(ExtraFieldHeader.Data_Size-1,soFromCurrent);
end
else else
begin begin
// Read past non-Zip64 extra field // Read past non-Zip64 extra field
@ -2342,7 +2422,8 @@ Begin
end; end;
end; end;
Function TUnZipper.CreateDeCompressor(Item : TZipFileEntry; AMethod : Word;AZipFile,AOutFile : TStream) : TDeCompressor; function TUnZipper.CreateDeCompressor(Item: TZipFileEntry; AMethod: Word;
AZipFile, AOutFile: TStream): TDeCompressor;
begin begin
case AMethod of case AMethod of
8 : 8 :
@ -2352,14 +2433,14 @@ begin
end; end;
end; end;
Procedure TUnZipper.UnZipOneFile(Item : TFullZipFileEntry); procedure TUnZipper.UnZipOneFile(Item: TFullZipFileEntry);
Var Var
Count: int64; Count: int64;
Attrs: Longint; Attrs: Longint;
ZMethod : Word; ZMethod : Word;
LinkTargetStream: TStringStream; LinkTargetStream: TStringStream;
OutputFileName: string; OutputFileName: RawByteString;
FOutStream: TStream; FOutStream: TStream;
IsLink: Boolean; IsLink: Boolean;
IsCustomStream: Boolean; IsCustomStream: Boolean;
@ -2399,7 +2480,11 @@ Begin
Raise EZipError.CreateFmt(SErrPatchSetNotSupported,[Item.ArchiveFileName]); Raise EZipError.CreateFmt(SErrPatchSetNotSupported,[Item.ArchiveFileName]);
// Normalize output filename to conventions of target platform. // Normalize output filename to conventions of target platform.
// Zip file always has / path separators // Zip file always has / path separators
OutputFileName:=StringReplace(Item.DiskFileName,'/',DirectorySeparator,[rfReplaceAll]);
if UseUTF8 then
OutputFileName:=StringReplace(Item.UTF8DiskFileName,'/',DirectorySeparator,[rfReplaceAll])
else
OutputFileName:=StringReplace(Item.DiskFileName,'/',DirectorySeparator,[rfReplaceAll]);
IsCustomStream := Assigned(FOnCreateStream); IsCustomStream := Assigned(FOnCreateStream);
@ -2488,7 +2573,17 @@ Begin
end; end;
Procedure TUnZipper.UnZipAllFiles; procedure TUnZipper.UnZipAllFiles;
Function IsMatch(I : TFullZipFileEntry) : Boolean;
begin
if UseUTF8 then
Result:=(FFiles.IndexOf(I.UTF8ArchiveFileName)<>-1)
else
Result:=(FFiles.IndexOf(I.ArchiveFileName)<>-1)
end;
Var Var
Item : TFullZipFileEntry; Item : TFullZipFileEntry;
I : integer; //Really QWord but limited to FEntries.Count I : integer; //Really QWord but limited to FEntries.Count
@ -2504,7 +2599,7 @@ Begin
for i:=0 to FEntries.Count-1 do for i:=0 to FEntries.Count-1 do
begin begin
Item:=FEntries[i]; Item:=FEntries[i];
if AllFiles or (FFiles.IndexOf(Item.ArchiveFileName)<>-1) then if AllFiles or IsMatch(Item) then
UnZipOneFile(Item); UnZipOneFile(Item);
end; end;
Finally Finally
@ -2516,7 +2611,7 @@ Begin
end; end;
Procedure TUnZipper.SetBufSize(Value : LongWord); procedure TUnZipper.SetBufSize(Value: LongWord);
begin begin
If FUnZipping then If FUnZipping then
@ -2525,7 +2620,7 @@ begin
FBufSize:=Value; FBufSize:=Value;
end; end;
Procedure TUnZipper.SetFileName(Value : String); procedure TUnZipper.SetFileName(Value: String);
begin begin
If FUnZipping then If FUnZipping then
@ -2533,14 +2628,14 @@ begin
FFileName:=Value; FFileName:=Value;
end; end;
Procedure TUnZipper.SetOutputPath(Value:String); procedure TUnZipper.SetOutputPath(Value: String);
begin begin
If FUnZipping then If FUnZipping then
Raise EZipError.Create(SErrFileChange); Raise EZipError.Create(SErrFileChange);
FOutputPath:=Value; FOutputPath:=Value;
end; end;
Procedure TUnZipper.UnZipFiles(AFileName : String; FileList : TStrings); procedure TUnZipper.UnZipFiles(AFileName: String; FileList: TStrings);
begin begin
FFileName:=AFileName; FFileName:=AFileName;
@ -2553,14 +2648,14 @@ begin
UnZipAllFiles; UnZipAllFiles;
end; end;
Procedure TUnZipper.UnZipAllFiles(AFileName : String); procedure TUnZipper.UnZipAllFiles(AFileName: String);
begin begin
FFileName:=AFileName; FFileName:=AFileName;
UnZipAllFiles; UnZipAllFiles;
end; end;
Procedure TUnZipper.DoEndOfFile; procedure TUnZipper.DoEndOfFile;
Var Var
ComprPct : Double; ComprPct : Double;
@ -2588,7 +2683,7 @@ begin
FOnEndOfFile(Self,ComprPct); FOnEndOfFile(Self,ComprPct);
end; end;
Constructor TUnZipper.Create; constructor TUnZipper.Create;
begin begin
FBufSize:=DefaultBufSize; FBufSize:=DefaultBufSize;
@ -2598,7 +2693,7 @@ begin
FOnPercent:=1; FOnPercent:=1;
end; end;
Procedure TUnZipper.Clear; procedure TUnZipper.Clear;
begin begin
FFiles.Clear; FFiles.Clear;
@ -2619,7 +2714,7 @@ begin
end; end;
end; end;
Destructor TUnZipper.Destroy; destructor TUnZipper.Destroy;
begin begin
Clear; Clear;
@ -2637,6 +2732,20 @@ begin
Result:=FDiskFileName; Result:=FDiskFileName;
end; end;
function TZipFileEntry.GetUTF8ArchiveFileName: UTF8String;
begin
Result:=FUTF8FileName;
If Result='' then
Result:=ArchiveFileName;
end;
function TZipFileEntry.GetUTF8DiskFileName: UTF8String;
begin
Result:=FUTF8DiskFileName;
If Result='' then
Result:=DiskFileName;
end;
constructor TZipFileEntry.Create(ACollection: TCollection); constructor TZipFileEntry.Create(ACollection: TCollection);
begin begin
@ -2700,6 +2809,26 @@ begin
FDiskFileName:=StringReplace(AValue,'/',DirectorySeparator,[rfReplaceAll]); FDiskFileName:=StringReplace(AValue,'/',DirectorySeparator,[rfReplaceAll]);
end; end;
procedure TZipFileEntry.SetUTF8ArchiveFileName(AValue: UTF8String);
begin
FUTF8FileName:=AValue;
If ArchiveFileName='' then
if DefaultSystemCodePage<>CP_UTF8 then
ArchiveFileName:=Utf8ToAnsi(AValue)
else
ArchiveFileName:=AValue;
end;
procedure TZipFileEntry.SetUTF8DiskFileName(AValue: UTF8String);
begin
FUTF8DiskFileName:=AValue;
If DiskFileName='' then
if DefaultRTLFileSystemCodePage<>CP_UTF8 then
DiskFileName:=Utf8ToAnsi(AValue)
else
DiskFileName:=AValue;
end;
procedure TZipFileEntry.Assign(Source: TPersistent); procedure TZipFileEntry.Assign(Source: TPersistent);