给 System.Zip 增长了个（多文件解压时的）解压进度事务
转 http://www.byywee.com/page/M0/S681/681754.html
很喜好 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 >;
private class var
FCompressionHandler: TCompressionDict;
private
FMode: TZipMode;
FStream: TStream;
FFileStream: TFileStream;
FStartFileData: Int64;
FEndFileData: Int64;
FFiles: TList;
FComment: String;
FUTF8Support: Boolean;
function GetFileComment（Index: Integer）: string;
function GetFileCount: Integer;
function GetFileInfo（Index: Integer）: TZipHeader;
function GetFileInfos: TArray;
function GetFileName（Index: Integer）: string;
function GetFileNames: TArray;
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 read GetFileNames;
property FileInfos: TArray 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;
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;
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.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.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.