很喜欢 System.Zip; 手头的程序需要把压缩后的一组文件从内存流解压, 这用 System.Zip 非常简单, 但我需要呈现解压进度, 同时给出当前文件名.
因此给 System.Zip.TZipFile 添加了一个 OnUnZipProgress 事件.
在 System.Zip 的基础上添加了不足 10 行代码, 新加代码都在行尾标记了 ///.
修改后的文件(Zip2.pas):
unit Zip2; interface uses System.SysUtils, System.IOUtils, System.Generics.Collections, System.Classes; type TZipCompression = ( zcStored = 0, zcShrunk, zcReduce1, zcReduce2, zcReduce3, zcReduce4, zcImplode, zcTokenize, zcDeflate, zcDeflate64, zcPKImplode, {11 RESERVED} zcBZIP2 = 12, {13 RESERVED} zcLZMA = 14, {15-17 RESERVED} zcTERSE = 18, zcLZ77, zcWavePack = 97, zcPPMdI1 ); function TZipCompressionToString(Compression: TZipCompression): string; const SIGNATURE_ZIPENDOFHEADER: UInt32 = $06054B50; SIGNATURE_CENTRALHEADER: UInt32 = $02014B50; SIGNATURE_LOCALHEADER: UInt32 = $04034B50; LOCALHEADERSIZE = 26; CENTRALHEADERSIZE = 42; type TZipEndOfCentralHeader = packed record DiskNumber: UInt16; CentralDirStartDisk: UInt16; NumEntriesThisDisk: UInt16; CentralDirEntries: UInt16; CentralDirSize: UInt32; CentralDirOffset: UInt32; CommentLength: UInt16; end; TZipHeader = packed record MadeByVersion: UInt16; RequiredVersion: UInt16; Flag: UInt16; CompressionMethod: UInt16; ModifiedDateTime: UInt32; CRC32: UInt32; CompressedSize: UInt32; UncompressedSize: UInt32; FileNameLength: UInt16; ExtraFieldLength: UInt16; FileCommentLength: UInt16; DiskNumberStart: UInt16; InternalAttributes: UInt16; ExternalAttributes: UInt32; LocalHeaderOffset: UInt32; FileName: RawByteString; ExtraField: TBytes; FileComment: RawByteString; end; PZipHeader = ^TZipHeader; EZipException = class( Exception ); TZipMode = (zmClosed, zmRead, zmReadWrite, zmWrite); TZipFile = class; TStreamConstructor = reference to function(InStream: TStream; const ZipFile: TZipFile; const Item: TZipHeader): TStream; TUnZipProgressEvent = procedure(Sender: TObject; ACount,AIndex: Integer; AFileName: string) of object; /// TZipFile = class private type TCompressionDict = TDictionary< TZipCompression , TPair<TStreamConstructor, TStreamConstructor > >; private class var FCompressionHandler: TCompressionDict; private FMode: TZipMode; FStream: TStream; FFileStream: TFileStream; FStartFileData: Int64; FEndFileData: Int64; FFiles: TList<TZipHeader>; FComment: String; FUTF8Support: Boolean; function GetFileComment(Index: Integer): string; function GetFileCount: Integer; function GetFileInfo(Index: Integer): TZipHeader; function GetFileInfos: TArray<TZipHeader>; function GetFileName(Index: Integer): string; function GetFileNames: TArray<string>; procedure ReadCentralHeader; procedure SetFileComment(Index: Integer; Value: string); procedure SetUTF8Support(const Value: Boolean); function LocateEndOfCentralHeader(var Header: TZipEndOfCentralHeader): Boolean; protected /// FOnUnZipProgress: TUnZipProgressEvent; /// procedure DoUnZipProgress(ACount,AIndex: Integer; AFileName: string); /// public class constructor Create; class destructor Destroy; class procedure RegisterCompressionHandler(Compression: TZipCompression; CompressStream, DecompressStream: TStreamConstructor); class function IsValid(ZipFileName: string): Boolean; static; class procedure ExtractZipFile(ZipFileName: string; Path: string); static; class procedure ZipDirectoryContents(ZipFileName: string; Path: string; Compression: TZipCompression = zcDeflate); static; constructor Create; destructor Destroy; override; procedure Open(ZipFileName: string; OpenMode: TZipMode); overload; procedure Open(ZipFileStream: TStream; OpenMode: TZipMode); overload; procedure Close; procedure Extract(FileName: string; Path: string = ''; CreateSubdirs: Boolean=True); overload; procedure Extract(Index: Integer; Path: string = ''; CreateSubdirs: Boolean=True); overload; procedure ExtractAll(Path: string = ''); procedure Read(FileName: string; out Bytes: TBytes); overload; procedure Read(Index: Integer; out Bytes: TBytes); overload; procedure Read(FileName: string; out Stream: TStream; out LocalHeader: TZipHeader); overload; procedure Read(Index: Integer; out Stream: TStream; out LocalHeader: TZipHeader); overload; procedure Add(FileName: string; ArchiveFileName: string = ''; Compression: TZipCompression = zcDeflate); overload; procedure Add(Data: TBytes; ArchiveFileName: string; Compression: TZipCompression = zcDeflate); overload; procedure Add(Data: TStream; ArchiveFileName: string; Compression: TZipCompression = zcDeflate); overload; procedure Add(Data: TStream; LocalHeader: TZipHeader; CentralHeader: PZipHeader = nil); overload; function IndexOf(FileName: string): Integer; property Mode: TZipMode read FMode; property FileCount: Integer read GetFileCount; property FileNames: TArray<string> read GetFileNames; property FileInfos: TArray<TZipHeader> read GetFileInfos; property FileName[Index: Integer]: string read GetFileName; property FileInfo[Index: Integer]: TZipHeader read GetFileInfo; property FileComment[Index: Integer]: string read GetFileComment write SetFileComment; property Comment: string read FComment write FComment; property UTF8Support: Boolean read FUTF8Support write SetUTF8Support default True; property OnUnZipProgress: TUnZipProgressEvent read FOnUnZipProgress write FOnUnZipProgress; /// end; implementation uses System.RTLConsts, System.ZLib; type TOem437String = type AnsiString(437); procedure VerifyRead(Stream: TStream; var Buffer; Count: Integer); begin if Stream.Read(Buffer, Count) <> Count then raise EZipException.CreateRes(@SZipErrorRead) at ReturnAddress; end; procedure VerifyWrite(Stream: TStream; var Buffer; Count: Integer); begin if Stream.Write(Buffer, Count) <> Count then raise EZipException.CreateRes(@SZipErrorWrite) at ReturnAddress; end; type TStoredStream = class( TStream ) private FStream: TStream; FPos: Int64; protected function GetSize: Int64; override; public constructor Create( Stream: TStream ); function Read(var Buffer; Count: Longint): Longint; override; function Write(const Buffer; Count: Longint): Longint; override; function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; end; { TStoredStream } constructor TStoredStream.Create(Stream: TStream); begin FStream := Stream; FPos := FStream.Position; end; function TStoredStream.GetSize: Int64; begin Result := FStream.Size; end; function TStoredStream.Read(var Buffer; Count: Integer): Longint; begin Result := FStream.Read(Buffer, Count); end; function TStoredStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; begin Result := FStream.Seek(Offset, Origin) end; function TStoredStream.Write(const Buffer; Count: Integer): Longint; begin Result := FStream.Write(Buffer, Count); end; function TZipCompressionToString(Compression: TZipCompression): string; begin case Compression of zcStored: Result := 'Stored'; zcShrunk: Result := 'Shrunk'; zcReduce1: Result := 'Reduced1'; zcReduce2: Result := 'Reduced2'; zcReduce3: Result := 'Reduced3'; zcReduce4: Result := 'Reduced4'; zcImplode: Result := 'Imploded'; zcTokenize: Result := 'Tokenized'; zcDeflate: Result := 'Deflated'; zcDeflate64: Result := 'Deflated64'; zcPKImplode: Result := 'Imploded(TERSE)'; zcBZIP2: Result := 'BZIP2'; zcLZMA: Result := 'LZMA'; zcTERSE: Result := 'TERSE'; zcLZ77: Result := 'LZ77'; zcWavePack: Result := 'WavPack'; zcPPMdI1: Result := 'PPMd version I, Rev 1'; else Result := 'Unknown'; end; end; { TZipFile } function TZipFile.GetFileComment(Index: Integer): string; begin if FMode = zmClosed then raise EZipException.CreateRes(@SZipNotOpen); Result := string(FFiles[Index].FileComment); end; function TZipFile.GetFileCount: Integer; begin if FMode = zmClosed then raise EZipException.CreateRes(@SZipNotOpen); Result := FFiles.Count; end; function TZipFile.GetFileInfo(Index: Integer): TZipHeader; begin if FMode = zmClosed then raise EZipException.CreateRes(@SZipNotOpen); Result := FFiles[Index]; end; function TZipFile.GetFileInfos: TArray<TZipHeader>; begin if FMode = zmClosed then raise EZipException.CreateRes(@SZipNotOpen); Result := FFiles.ToArray; end; function TZipFile.GetFileName(Index: Integer): string; begin if FMode = zmClosed then raise EZipException.CreateRes(@SZipNotOpen); Result := string(FFiles[Index].FileName); end; function TZipFile.GetFileNames: TArray<string>; var I: Integer; begin if FMode = zmClosed then raise EZipException.CreateRes(@SZipNotOpen); SetLength(Result, FFiles.Count); for I := 0 to High(Result) do Result[I] := string(FFiles[I].FileName); end; procedure TZipFile.ReadCentralHeader; var I: Integer; Signature: UInt32; LEndHeader: TZipEndOfCentralHeader; LHeader: TZipHeader; begin FFiles.Clear; if FStream.Size = 0 then Exit; if not LocateEndOfCentralHeader(LEndHeader) then raise EZipException.CreateRes(@SZipErrorRead); FStream.Position := LEndHeader.CentralDirOffset; FEndFileData := LEndHeader.CentralDirOffset; for I := 0 to LEndHeader.CentralDirEntries - 1 do begin FStream.Read(Signature, Sizeof(Signature)); if Signature <> SIGNATURE_CENTRALHEADER then raise EZipException.CreateRes(@SZipInvalidCentralHeader); VerifyRead(FStream, LHeader.MadeByVersion, CENTRALHEADERSIZE); if LHeader.FileNameLength > 0 then begin SetLength(LHeader.FileName, LHeader.FileNameLength); if (LHeader.Flag and (1 SHL 11)) <> 0 then SetCodepage(LHeader.FileName, 65001, False) else SetCodepage(LHeader.FileName, 437, False); VerifyRead(FStream, LHeader.FileName[1], LHeader.FileNameLength); end; if LHeader.ExtraFieldLength > 0 then begin SetLength(LHeader.ExtraField, LHeader.ExtraFieldLength); VerifyRead(FStream, LHeader.ExtraField[0], LHeader.ExtraFieldLength); end; if LHeader.FileCommentLength > 0 then begin SetLength(LHeader.FileComment, LHeader.FileCommentLength); if (LHeader.Flag and (1 SHL 11)) <> 0 then SetCodepage(LHeader.FileName, 65001, False) else SetCodepage(LHeader.FileName, 437, False); VerifyRead(FStream, LHeader.FileComment[1], LHeader.FileCommentLength); end; if (LHeader.Flag and (1 shl 11)) = 0 then FUTF8Support := False; FFiles.Add(LHeader); end; end; procedure TZipFile.SetFileComment(Index: Integer; Value: string); var LFile: TZipHeader; begin if not (FMode in [zmReadWrite, zmWrite]) then raise EZipException.CreateRes(@SZipNoWrite); LFile := FFiles[Index]; if Length(Value) > $FFFF then SetLength(Value, $FFFF); if UTF8Support then LFile.FileComment := UTF8Encode(Value) else LFile.FileComment := TOem437String(Value); LFile.FileCommentLength := Length(LFile.FileComment); FFiles[Index] := LFile; end; procedure TZipFile.SetUTF8Support(const Value: Boolean); begin if Value = FUTF8Support then Exit; if not (FMode in [zmReadWrite, zmWrite]) then raise EZipException.CreateRes(@SZipNoWrite); if FFiles.Count <> 0 then raise EZipException.CreateRes(@SZipNotEmpty); FUTF8Support := Value; end; class constructor TZipFile.Create; begin FCompressionHandler := TCompressionDict.Create; RegisterCompressionHandler(zcStored, function(InStream: TStream; const ZipFile: TZipFile; const Item: TZipHeader): TStream begin Result := TStoredStream.Create(InStream); end, function(InStream: TStream; const ZipFile: TZipFile; const Item: TZipHeader): TStream begin Result := TStoredStream.Create(InStream); end); RegisterCompressionHandler(zcDeflate, function(InStream: TStream; const ZipFile: TZipFile; const Item: TZipHeader): TStream begin Result := TZCompressionStream.Create(InStream, zcDefault, -15); end, function(InStream: TStream; const ZipFile: TZipFile; const Item: TZipHeader): TStream begin Result := TZDecompressionStream.Create(InStream, -15); end); end; class destructor TZipFile.Destroy; begin FCompressionHandler.Free; end; class procedure TZipFile.RegisterCompressionHandler( Compression: TZipCompression; CompressStream, DecompressStream: TStreamConstructor); begin FCompressionHandler.AddOrSetValue(Compression, TPair<TStreamConstructor, TStreamConstructor>.Create(CompressStream, DecompressStream)); end; class function TZipFile.IsValid(ZipFileName: string): Boolean; var Z: TZipFile; Header: TZipEndOfCentralHeader; begin Result := False; try Z := tzipfile.Create; try Z.FStream := TFileStream.Create(ZipFileName, fmOpenRead); try Result := Z.LocateEndOfCentralHeader(Header); finally Z.FStream.Free; end; finally Z.Free; end; except on E: Exception do end; end; function TZipFile.LocateEndOfCentralHeader(var Header: TZipEndOfCentralHeader): Boolean; var I: Integer; LBackRead, LReadSize, LMaxBack: UInt32; LBackBuf: array[0..$404-1] of Byte; begin if FStream.Size < $FFFF then LMaxBack := FStream.Size else LMaxBack := $FFFF; LBackRead := 4; while LBackRead < LMaxBack do begin if LBackRead + Cardinal(Length(LBackBuf) - 4) > LMaxBack then LBackRead := LMaxBack else Inc(LBackRead, Length(LBackBuf) -4); FStream.Position := FStream.Size - LBackRead; if Length(LBackBuf) < (FStream.Size - FStream.Position) then LReadSize := Length(LBackBuf) else LReadSize := FStream.Size - FStream.Position; VerifyRead(FStream, LBackBuf[0], LReadSize); for I := LReadSize - 4 downto 0 do begin if PCardinal(@LBackBuf[I])^ = SIGNATURE_ZIPENDOFHEADER then begin Move(LBackBuf[I+4], Header, SizeOf(Header)); if Header.CommentLength > 0 then begin FStream.Position := FStream.Size - LBackRead + I + 4 + SizeOf(Header); SetLength(FComment, Header.CommentLength); FStream.Read(FComment[1], Header.CommentLength); end else FComment := ''; Exit(True); end; end; end; Result := False; end; class procedure TZipFile.ExtractZipFile(ZipFileName: string; Path: string); var LZip: TZipFile; begin LZip := TZipFile.Create; try LZip.Open(ZipFileName, zmRead); LZip.ExtractAll(Path); LZip.Close; finally LZip.Free; end; end; class procedure TZipFile.ZipDirectoryContents(ZipFileName: string; Path: string; Compression: TZipCompression); var LZipFile: TZipFile; LFile: string; LZFile: string; begin LZipFile := TZipFile.Create; try LZipFile.Open(ZipFileName, zmWrite); if Path[Length(Path)] <> PathDelim then Path := Path + PathDelim; for LFile in TDirectory.GetFiles(Path, '*', TSearchOption.soAllDirectories) do begin {$IFDEF MSWINDOWS} LZFile := StringReplace( Copy(LFile, Length(Path)+1, Length(LFile)), '\', '/', [rfReplaceAll]); {$ELSE} LZFile := Copy(LFile, Length(Path)+1, Length(LFile)); {$ENDIF MSWINDOWS} LZipFile.Add(LFile, LZFile, Compression); end; finally LZipFile.Free; end; end; constructor TZipFile.Create; begin inherited Create; FFiles := TList<TZipHeader>.Create; FMode := zmClosed; FUTF8Support := True; end; destructor TZipFile.Destroy; begin Close; FFiles.Free; inherited; end; procedure TZipFile.DoUnZipProgress(ACount, AIndex: Integer; AFileName: string); /// begin /// if Assigned(FOnUnZipProgress) then /// FOnUnZipProgress(Self, ACount, AIndex, AFileName); end; procedure TZipFile.Open(ZipFileName: string; OpenMode: TZipMode); var LMode: LongInt; LFileStream: TFileStream; begin Close; case OpenMode of zmRead: LMode := fmOpenRead; zmReadWrite: LMode := fmOpenReadWrite; zmWrite: LMode := fmCreate; else raise EZipException.CreateRes(@sArgumentInvalid); end; LFileStream := TFileStream.Create(ZipFileName, LMode); try Open(LFileStream, OpenMode); FFileStream := LFileStream; except FreeAndNil(LFileStream); raise; end; end; procedure TZipFile.Open(ZipFileStream: TStream; OpenMode: TZipMode); begin Close; if OpenMode = zmClosed then raise EZipException.CreateRes(@sArgumentInvalid); if (OpenMode = zmRead) and (ZipFileStream.Size = 0) then raise EZipException.CreateRes(@SReadError); FStream := ZipFileStream; FStartFileData := FStream.Position; if OpenMode in [zmRead, zmReadWrite] then try ReadCentralHeader; except FStream := nil; raise; end; FMode := OpenMode; end; procedure TZipFile.Close; var LHeader: TZipHeader; LEndOfHeader: TZipEndOfCentralHeader; I: Integer; Signature: UInt32; begin try if (FMode = zmReadWrite) or (FMode = zmWrite) then begin FStream.Position := FEndFileData; Signature := SIGNATURE_CENTRALHEADER; for I := 0 to FFiles.Count - 1 do begin LHeader := FFiles[I]; VerifyWrite(FStream, Signature, SizeOf(Signature)); VerifyWrite(FStream, LHeader.MadeByVersion, CENTRALHEADERSIZE); if LHeader.FileNameLength <> 0 then VerifyWrite(FStream, LHeader.FileName[1], LHeader.FileNameLength); if LHeader.ExtraFieldLength <> 0 then VerifyWrite(FStream, LHeader.ExtraField[1], LHeader.ExtraFieldLength); if LHeader.FileCommentLength <> 0 then VerifyWrite(FStream, LHeader.FileComment[1], LHeader.FileCommentLength); end; FillChar(LEndOfHeader, Sizeof(LEndOfHeader), 0); LEndOfHeader.CentralDirEntries := FFiles.Count; LEndOfHeader.NumEntriesThisDisk := FFiles.Count; LEndOfHeader.CentralDirSize := FStream.Position - FEndFileData; LEndOfHeader.CentralDirOffset := FEndFileData; if Length(FComment) > $FFFF then SetLength(FComment, $FFFF); LEndofHeader.CommentLength := Length(FComment); Signature := SIGNATURE_ZIPENDOFHEADER; VerifyWrite(FStream, Signature, SizeOf(Signature)); VerifyWrite(FStream, LEndOfHeader, SizeOf(LEndOfHeader)); if LEndOfHeader.CommentLength > 0 then VerifyWrite(FStream, FComment[1], LEndOfHeader.CommentLength); end; finally FMode := zmClosed; FFiles.Clear; FStream := nil; if Assigned(FFileStream) then FreeAndNil(FFileStream); end; end; procedure TZipFile.Extract(FileName: string; Path: string; CreateSubDirs: Boolean); begin Extract(IndexOf(FileName), Path, CreateSubdirs); end; procedure TZipFile.Extract(Index: Integer; Path: string; CreateSubdirs: Boolean); var LInStream, LOutStream: TStream; LHeader: TZipHeader; LDir, LFileName: string; Bytes: array [0..4095] of Byte; ReadBytes: Int64; begin Read(Index, LInStream, LHeader); try LFileName := string(FFiles[Index].FileName); {$IFDEF MSWINDOWS} LFileName := StringReplace(LFileName, '/', '\', [rfReplaceAll]); {$ENDIF} if CreateSubdirs then LFileName := TPath.Combine(Path, LFileName) else LFileName := TPath.Combine(Path, ExtractFileName(LFileName)); LDir := ExtractFileDir(LFileName); if CreateSubdirs and (LDir <> '') then TDirectory.CreateDirectory(ExtractFileDir(LFileName)); if LFileName[Length(LFileName)] = PathDelim then Exit; LOutStream := TFileStream.Create(LFileName, fmCreate); try if (LHeader.Flag and (1 SHL 3)) = 0 then if FFiles[Index].UncompressedSize > 0 then LOutStream.CopyFrom(LInStream, FFiles[Index].UncompressedSize) else begin while True do begin ReadBytes := LInStream.Read(Bytes, Length(Bytes)); LOutStream.Write(Bytes, ReadBytes); if ReadBytes < Length(Bytes) then break; end; end; finally LOutStream.Free; end; finally LInStream.Free; end; end; procedure TZipFile.ExtractAll(Path: string); var I: Integer; begin if not (FMode in [zmReadWrite, zmRead]) then raise EZipException.CreateRes(@SZipNoRead); for I := 0 to FFiles.Count - 1 do begin /// Extract(I, Path); DoUnZipProgress(FileCount, I+1, FileName[I]); /// end; /// end; procedure TZipFile.Read(FileName: string; out Bytes: TBytes); begin Read(IndexOf(FileName), Bytes); end; procedure TZipFile.Read(Index: Integer; out Bytes: TBytes); var LStream: TStream; LHeader: TZipHeader; ReadStart, ReadBytes: Int64; begin Read(Index, LStream, LHeader); try if (LHeader.Flag and (1 SHL 3)) = 0 then begin SetLength(Bytes, FFiles[Index].UncompressedSize); if FFiles[Index].UncompressedSize > 0 then VerifyRead(LStream, Bytes[0], LHeader.UncompressedSize); end else begin SetLength(Bytes, 4096); ReadStart := 0; ReadBytes := 0; while True do begin ReadBytes := LStream.Read(Bytes[ReadStart], Length(Bytes)-ReadStart); if ReadBytes < (Length(Bytes) - ReadStart) then break; ReadStart := ReadStart + ReadBytes; SetLength(Bytes, Length(Bytes)*2); end; SetLength(Bytes, ReadStart + ReadBytes); end; finally LStream.Free; end; end; procedure TZipFile.Read(FileName: string; out Stream: TStream; out LocalHeader: TZipHeader); begin Read(IndexOf(FileName), Stream, LocalHeader); end; procedure TZipFile.Read(Index: Integer; out Stream: TStream; out LocalHeader: TZipHeader); var Signature: UInt32; begin if not (FMode in [zmReadWrite, zmRead]) then raise EZipException.CreateRes(@SZipNoRead); if (Index < 0) or (Index > FFiles.Count) then raise EZipException.CreateRes(@SFileNotFound); LocalHeader.MadeByVersion := 0; LocalHeader.FileComment := ''; LocalHeader.FileCommentLength := 0; LocalHeader.DiskNumberStart := 0; LocalHeader.InternalAttributes := 0; LocalHeader.ExternalAttributes := 0; LocalHeader.LocalHeaderOffset := 0; FStream.Position := FFiles[Index].LocalHeaderOffset + FStartFileData; FStream.Read(Signature, Sizeof(Signature)); if Signature <> SIGNATURE_LOCALHEADER then raise EZipException.CreateRes(@SZipInvalidLocalHeader); FStream.Read(LocalHeader.RequiredVersion, LOCALHEADERSIZE); SetLength(LocalHeader.FileName, LocalHeader.FileNameLength); SetLength(LocalHeader.ExtraField, LocalHeader.ExtraFieldLength); if (LocalHeader.Flag and (1 SHL 11)) <> 0 then SetCodepage(LocalHeader.FileName, 65001, False) else SetCodepage(LocalHeader.FileName, 437, False); FStream.Read(LocalHeader.FileName[1], LocalHeader.FileNameLength); if LocalHeader.ExtraFieldLength > 0 then FStream.Read(LocalHeader.ExtraField[0], LocalHeader.ExtraFieldLength); Stream := FCompressionHandler[TZipCompression(FFiles[Index].CompressionMethod)].Value(FStream, Self, LocalHeader); end; procedure TZipFile.Add(Data: TStream; LocalHeader: TZipHeader; CentralHeader: PZipHeader); var DataStart: Int64; LCompressStream: TStream; Signature: UInt32; LStartPos: Int64; LBuffer: array[0..$4000] of Byte; begin FStream.Position := FEndFileData; LocalHeader.LocalHeaderOffset := FEndFileData; if LocalHeader.MadeByVersion < 20 then LocalHeader.MadeByVersion := 20; if LocalHeader.RequiredVersion < 20 then LocalHeader.RequiredVersion := 20; LocalHeader.FileNameLength := Length(LocalHeader.FileName); LocalHeader.ExtraFieldLength := Length(LocalHeader.ExtraField); if CentralHeader = nil then CentralHeader := @LocalHeader else begin CentralHeader^.FileNameLength := Length(CentralHeader^.FileName); CentralHeader^.ExtraFieldLength := Length(CentralHeader^.ExtraField); end; CentralHeader^.FileCommentLength := Length(CentralHeader^.FileComment); Signature := SIGNATURE_LOCALHEADER; VerifyWrite(FStream, Signature, SizeOf(Signature)); VerifyWrite(FStream, LocalHeader.RequiredVersion, LOCALHEADERSIZE); VerifyWrite(FStream, LocalHeader.FileName[1], LocalHeader.FileNameLength); if LocalHeader.ExtraFieldLength > 0 then VerifyWrite(FStream, LocalHeader.ExtraField[0], LocalHeader.ExtraFieldLength); LStartPos := FStream.Position; DataStart := Data.Position; LocalHeader.UncompressedSize := Data.Size - DataStart; LCompressStream := FCompressionHandler[TZipCompression(LocalHeader.CompressionMethod)].Key(FStream, self, LocalHeader); try LCompressStream.CopyFrom(Data, LocalHeader.UncompressedSize); finally LCompressStream.Free; end; LocalHeader.CompressedSize := FStream.Position - LStartPos; Data.Position := DataStart; while Data.Position < LocalHeader.UncompressedSize do LocalHeader.CRC32 := crc32(LocalHeader.CRC32, @LBuffer[0], Data.Read(LBuffer, SizeOf(LBuffer))); CentralHeader.UnCompressedSize := LocalHeader.UnCompressedSize; CentralHeader.CompressedSize := LocalHeader.CompressedSize; CentralHeader.CRC32 := LocalHeader.CRC32; FEndFileData := FStream.Position; FStream.Position := LocalHeader.LocalHeaderOffset + SizeOf(UInt32); FStream.Write(LocalHeader.RequiredVersion, LOCALHEADERSIZE); FFiles.Add(CentralHeader^); end; procedure TZipFile.Add(FileName: string; ArchiveFileName: string; Compression: TZipCompression); var LInStream: TStream; LHeader: TZipHeader; begin if not (FMode in [zmReadWrite, zmWrite]) then raise EZipException.CreateRes(@SZipNoWrite); if not FCompressionHandler.ContainsKey(Compression) then raise EZipException.CreateResFmt(@SZipNotSupported, [ TZipCompressionToString(Compression) ]); FillChar(LHeader, sizeof(LHeader), 0); LHeader.Flag := 0; LInStream := TFileStream.Create(FileName, fmOpenRead); try LHeader.Flag := 0; LHeader.CompressionMethod := UInt16(Compression); LHeader.ModifiedDateTime := DateTimeToFileDate( tfile.GetLastWriteTime(FileName) ); LHeader.UncompressedSize := LInStream.Size; LHeader.InternalAttributes := 0; LHeader.ExternalAttributes := 0; if ArchiveFileName = '' then ArchiveFileName := ExtractFileName(FileName); if FUTF8Support then begin LHeader.Flag := LHeader.Flag or (1 SHL 11); LHeader.FileName := UTF8Encode(ArchiveFileName); end else LHeader.FileName := TOem437String(ArchiveFileName); LHeader.FileNameLength := Length(LHeader.FileName); LHeader.ExtraFieldLength := 0; Add(LInStream, LHeader); finally LInStream.Free; end; end; procedure TZipFile.Add(Data: TBytes; ArchiveFileName: string; Compression: TZipCompression); var LInStream: TStream; begin if not (FMode in [zmReadWrite, zmWrite]) then raise EZipException.CreateRes(@SZipNoWrite); if not FCompressionHandler.ContainsKey(Compression) then raise EZipException.CreateResFmt(@SZipNotSupported, [ TZipCompressionToString(Compression) ]); LInStream := TBytesStream.Create(Data); try Add(LInStream, ArchiveFileName, Compression); finally LInStream.Free; end; end; procedure TZipFile.Add(Data: TStream; ArchiveFileName: string; Compression: TZipCompression); var LHeader: TZipHeader; begin if not (FMode in [zmReadWrite, zmWrite]) then raise EZipException.CreateRes(@SZipNoWrite); if not FCompressionHandler.ContainsKey(Compression) then raise EZipException.CreateResFmt(@SZipNotSupported, [ TZipCompressionToString(Compression) ]); FillChar(LHeader, sizeof(LHeader), 0); LHeader.Flag := 0; LHeader.CompressionMethod := UInt16(Compression); LHeader.ModifiedDateTime := DateTimeToFileDate( Now ); LHeader.InternalAttributes := 0; LHeader.ExternalAttributes := 0; if FUTF8Support then begin LHeader.Flag := LHeader.Flag or (1 SHL 11); LHeader.FileName := UTF8Encode(ArchiveFileName); end else LHeader.FileName := TOem437String(ArchiveFileName); LHeader.FileNameLength := Length(LHeader.FileName); LHeader.ExtraFieldLength := 0; Add(Data, LHeader); end; function TZipFile.IndexOf(FileName: string): Integer; var I: Integer; begin Result := -1; for I := 0 to FFiles.Count - 1 do if string(FFiles[I].FileName) = FileName then Exit(I); end; end.
测试:
unit Unit1; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls; type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); procedure OnProgress(Sender: TObject; ACount,AIndex: Integer; AFileName: string); end; var Form1: TForm1; implementation {$R *.dfm} uses Zip2; procedure TForm1.Button1Click(Sender: TObject); begin with TZipFile.Create do begin OnUnZipProgress := OnProgress; Open('C:\Temp\Test.zip', zmRead); ExtractAll('C:\Temp\Test\'); Free; end; end; procedure TForm1.OnProgress(Sender: TObject; ACount, AIndex: Integer; AFileName: string); begin Caption := Format('%d/%d: %s', [AIndex, ACount, AFileName]); Application.ProcessMessages; end; end.