ZLib的数据压缩和解压缩

Delphi的开发者可以使用ZLib单元中定义的TCompressionStream进行数据压缩，使用TDecompressionStream解压缩ZLib压缩后的数据。它们的定义如下：

TCustomZlibStream = class(TStream)
private
    FStrm: TStream;
    FStrmPos: Integer;
    FOnProgress: TNotifyEvent;
    FZRec: TZStreamRec;
    FBuffer: array [Word] of Char;
protected
    procedure Progress(Sender: TObject); dynamic;
    property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
    constructor Create(Strm: TStream);
end;

TCompressionStream = class(TCustomZlibStream)
private
    function GetCompressionRate: Single;
public
    constructor Create(CompressionLevel: TCompressionLevel; Dest: TStream);
    destructor Destroy; override;
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    property CompressionRate: Single read GetCompressionRate;
    property OnProgress;
end;

TDecompressionStream = class(TCustomZlibStream)
public
    constructor Create(Source: TStream);
    destructor Destroy; override;
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    property OnProgress;
end;

要使用这两个类，必须通过流（Stream）。事实上，它们的基类TCustomZlibStream就是TStream的派生类。他们的构造函数需要传入一个TStream的派生类对象，但是它们并不拥有（说准确点，是管理）这个传入流对象，代码编写者负责管理其生存期，传入构造函数参数后，它们会记住传入流的当前Position，之后的读或写将从这个位移开始。虽然 TCompressionStream 和 TDecompressionStream 都是流类，但是它们还是有特殊性的： TCompressionStream是只写的。调用其Read方法将引发一个异常；而 TDecompressionStream 是只读的，调用其Write方法也将引发异常。TCompressionStream把外界写入的数据压缩后存进其内部缓冲区，填满时把缓冲数据写进构造函数中传入的流对象，然后清空缓冲区，继续接受数据，如此循环往复。TCompressionStream的析构函数中会检查缓冲区中是否有数据，有的话不管是否填满，都写进构造函数中传入的流对象，因此一般来说，在TCompressionStream释放后，传入的流对象才包含了完整的压缩后数据。TDecompressionStream把其构造函数中传入的流对象包好的数据压缩后压缩后存储在缓冲区中，所以正确地构造TDecompressionStream对象后，就可以使用TDecompressionStream的Read方法来读取解压后的数据了。下面是示例代码：

{压缩，将ASrcStream包含的数据压缩，返回的TStream对象中包含了压缩结果数据}

function CompressStream(ASrcStream: TStream; ALevel: TSfCompressionLevel): TStream;
var
    ACompStrm:TCompressionStream;
    OriginSize:Int64;
begin
    Result:=TMemoryStream.Create;
    OriginSize:=ASrcStream.Size;
     //写入原始数据的字节数，方便解压时预先获知数据字节数
    Result.Write(OriginSize,SizeOf(OriginSize));
    ACompStrm:=TCompressionStream.Create(TCompressionLevel(ALevel),Result);
    try
        try
             //CopyFrom内部还是调用Write写入待压缩数据，只要写入，都将被压缩
            ACompStrm.CopyFrom(ASrcStream,0);
        except
            on E:Exception do SfRaiseException(E);
        end;
    finally
        SfFreeAndNil(ACompStrm);
    end;
end;

{解压缩数据，ASrcStream包含ZLib压缩数据，函数返回的TStream对象包含解压结果数据}
function DecompressStream(ASrcStream: TStream): TStream;
var
    ADecompStrm:TDecompressionStream;
    OriginSize:Int64;
begin
    ASrcStream.Position:=0;
   //读取原始数据大小，在解压前就可以预知解压结果的字节数
    ASrcStream.Read(OriginSize,SizeOf(OriginSize));
    ADecompStrm:=TDecompressionStream.Create(ASrcStream);
    Result:=TMemoryStream.Create;
    try
        try
            //读取解压结果
            Result.CopyFrom(ADecompStrm,OriginSize);
        except
            on E:Exception do SfRaiseException(E);
        end;
    finally
        SfFreeAndNil(ADecompStrm);
    end;
end;

示例代码中的SfRaiseException和SfFreeAndNil是偶项目中的自定义的函数，跟理解示例代码没有关联，所以不浪费时间说明它们。TSfCompressionLevel（压缩方式）只是对ZLib.pas中TCompressionLevel枚举的直接映射。

用TCompressionStream和TDecompressionStream实在麻烦，有没有直接的函数呢？有！而且就在ZLib.pas中，它们们是：

procedure CompressBuf(const InBuf: Pointer; InBytes: Integer;out OutBuf: Pointer; out OutBytes: Integer);

procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer;OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);

procedure DecompressToUserBuf(const InBuf: Pointer; InBytes: Integer;const OutBuf: Pointer; BufSize: Integer);

CompressBuf和DecompressBuf的参数类似，InBuf待压缩/解压的数据，InBytes为字节数。OutBuf为压缩/解压结果，OutBytes为结果字节数。对于DecompressBuf的OutEstimate，我们传入0就可以了。这两个函数内部自行分配存储结果数据所需要的内存，这是它们与DecompressToUserBuf的不同之处。DecompressToUserBuf要求调用者调用前就分配足够的内存来存储解压结果，它适用于预先知道原始数据字节数的情况，如果分配的内存不足，会引发异常。CompressBuf和DecompressBuf内部会处理异常，发生异常时释放为OutBuf分配的内存，然后重引发异常，函数的调用者要注意不要重复释放OutBuf，只有调用CompressBuf和DecompressBuf成功的情况下，调用者才能释放OutBuf返回的缓冲区。CompressBuf有一个缺点，就是它没有提供设置压缩方式的参数，总是使用Z_BEST_COMPRESSION（即clMax）方式压缩。不过只需要两行代码，我们可以改写它，加入压缩方式参数。以下是对这三个函数封装和改写后的单元（实际上只改写了CompressBuf函数，其它的都是直接抄写ZLib.pas，这么做只是为了使用的简便）：

unit SfCompressUtils;

interface

uses
    SysUtils,
    Classes,
    ZLib,
    ZLibConst;

const
    CompressionLevels: array[ TCompressionLevel ] of ShortInt =
    (
        Z_NO_COMPRESSION,
        Z_BEST_SPEED,
        Z_DEFAULT_COMPRESSION,
        Z_BEST_COMPRESSION
    );

procedure SfCompressBuf( const InBuf: Pointer; InBytes: Integer; out OutBuf: Pointer;
    out OutBytes: Integer; Level:TCompressionLevel = clDefault);


procedure SfDecompressBuf( const InBuf: Pointer; InBytes: Integer;
    OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer );


procedure SfDecompressToUserBuf( const InBuf: Pointer; InBytes: Integer;
    const OutBuf: Pointer; BufSize: Integer );


implementation

function CCheck( code: Integer ): Integer;
begin
    Result := code;
    if code < 0 then
        raise ECompressionError.Create( sError );
end;

function DCheck( code: Integer ): Integer;
begin
    Result := code;
    if code < 0 then
        raise EDecompressionError.Create( sError );
end;

procedure SfCompressBuf( const InBuf: Pointer; InBytes: Integer;
    out OutBuf: Pointer; out OutBytes: Integer; Level:TCompressionLevel );
var
    strm: TZStreamRec;
    P: Pointer;
begin
    FillChar( strm, sizeof( strm ), 0 );
    strm.zalloc := zlibAllocMem;
    strm.zfree := zlibFreeMem;
    OutBytes := ( ( InBytes + ( InBytes div 10 ) + 12 ) + 255 ) and not 255;
    GetMem( OutBuf, OutBytes );
    try
        strm.next_in := InBuf;
        strm.avail_in := InBytes;
        strm.next_out := OutBuf;
        strm.avail_out := OutBytes;
        CCheck( deflateInit_( strm, CompressionLevels[Level], zlib_version, sizeof( strm ) ) );
        try
            while CCheck( deflate( strm, Z_FINISH ) ) <> Z_STREAM_END do
            begin
                P := OutBuf;
                Inc( OutBytes, 256 );
                ReallocMem( OutBuf, OutBytes );
                strm.next_out := PChar( Integer( OutBuf ) + ( Integer( strm.next_out ) - Integer( P ) ) );
                strm.avail_out := 256;
            end;
        finally
            CCheck( deflateEnd( strm ) );
        end;
        ReallocMem( OutBuf, strm.total_out );
        OutBytes := strm.total_out;
    except
        FreeMem( OutBuf );
        raise;
    end;
end;


procedure SfDecompressBuf( const InBuf: Pointer; InBytes: Integer;
    OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer );
var
    strm: TZStreamRec;
    P: Pointer;
    BufInc: Integer;
begin
    FillChar( strm, sizeof( strm ), 0 );
    strm.zalloc := zlibAllocMem;
    strm.zfree := zlibFreeMem;
    BufInc := ( InBytes + 255 ) and not 255;
    if OutEstimate = 0 then
        OutBytes := BufInc
    else
        OutBytes := OutEstimate;
    GetMem( OutBuf, OutBytes );
    try
        strm.next_in := InBuf;
        strm.avail_in := InBytes;
        strm.next_out := OutBuf;
        strm.avail_out := OutBytes;
        DCheck( inflateInit_( strm, zlib_version, sizeof( strm ) ) );
        try
            while DCheck( inflate( strm, Z_FINISH ) ) <> Z_STREAM_END do
            begin
                P := OutBuf;
                Inc( OutBytes, BufInc );
                ReallocMem( OutBuf, OutBytes );
                strm.next_out := PChar( Integer( OutBuf ) + ( Integer( strm.next_out ) - Integer( P ) ) );
                strm.avail_out := BufInc;
            end;
        finally
            DCheck( inflateEnd( strm ) );
        end;
        ReallocMem( OutBuf, strm.total_out );
        OutBytes := strm.total_out;
    except
        FreeMem( OutBuf );
        raise
    end;
end;

procedure SfDecompressToUserBuf( const InBuf: Pointer; InBytes: Integer;
    const OutBuf: Pointer; BufSize: Integer );
var
    strm: TZStreamRec;
begin
    FillChar( strm, sizeof( strm ), 0 );
    strm.zalloc := zlibAllocMem;
    strm.zfree := zlibFreeMem;
    strm.next_in := InBuf;
    strm.avail_in := InBytes;
    strm.next_out := OutBuf;
    strm.avail_out := BufSize;
    DCheck( inflateInit_( strm, zlib_version, sizeof( strm ) ) );
    try
        if DCheck( inflate( strm, Z_FINISH ) ) <> Z_STREAM_END then
            raise EZlibError.CreateRes( @sTargetBufferTooSmall );
    finally
        DCheck( inflateEnd( strm ) );
    end;
end;

end.

以下是使用这些函数进行数据压缩和解压的示例代码：


{压缩流}
function CompressStream(ASrcStream: TStream; ALevel: TSfCompressionLevel): TStream;
var
    SrcData,Buffer:Pointer;
    BufSize:Integer;
begin
    Buffer:=nil;
    Result:=nil;
    BufSize:=0;
    GetMem(SrcData,ASrcStream.Size);
    ASrcStream.Position:=0;
    ASrcStream.Read(SrcData^,ASrcStream.Size);
    
    try
        try
            SfCompressBuf(SrcData,ASrcStream.Size,Buffer,BufSize,ALevel);
        except
            on E:Exception do
                SfRaiseException(E,'Exception raised in CompressStream call');
        end;
    finally
        FreeMem(SrcData);
        SrcData:=nil;
    end;

    //由于try...except块中重引发了异常，所以在发生了异常的情况下，以下的代码不会执行
    Result:=TMemoryStream.Create;
    Result.Write(Buffer^,BufSize);
    FreeMem(Buffer);
end;

{解压流}
function CompressStream(ASrcStream: TStream; ALevel: TSfCompressionLevel): TStream;
var
    SrcData,Buffer:Pointer;
    BufSize:Integer;
begin
    Buffer:=nil;
    Result:=nil;
    BufSize:=0;
    GetMem(SrcData,ASrcStream.Size);
    ASrcStream.Position:=0;
    ASrcStream.Read(SrcData^,ASrcStream.Size);
    
    try
        try
            SfCompressBuf(SrcData,ASrcStream.Size,Buffer,BufSize,ALevel);
        except
            on E:Exception do
                SfRaiseException(E,'Exception raised in CompressStream call');
        end;
    finally
        FreeMem(SrcData);
        SrcData:=nil;
    end;

    //由于try...except块中重引发了异常，所以在发生了异常的情况下，以下的代码不会执行
    Result:=TMemoryStream.Create;
    Result.Write(Buffer^,BufSize);
    FreeMem(Buffer);
end;

{压缩字节数组}
function CompressBytes(ASrcBytes: TBytes; ALevel: TSfCompressionLevel): TBytes;
var
    Buffer:Pointer;
    BufSize:Integer;
begin
    Buffer:=nil;
    BufSize:=0;
    
    try
        SfCompressBuf(@ASrcBytes[0],Length(ASrcBytes),Buffer,BufSize,ALevel);
        SetLength(Result,BufSize);
        Move(Buffer^,Result[0],BufSize);
    except
        on E:Exception do
            SfRaiseException(E,'Exception raised in CompressBytes call');
    end;

    //由于try...except块中重引发了异常，所以在发生了异常的情况下，以下的代码不会执行
    FreeMem(Buffer);
end;

{解压字节数组}
function DecompressBytes(ASrcBytes: TBytes): TBytes;
var
    Buffer:Pointer;
    BufSize:Integer;
begin
    Buffer:=nil;
    BufSize:=0;

    try
        SfDecompressBuf(@ASrcBytes[0],Length(ASrcBytes),0,Buffer,BufSize);
        SetLength(Result,BufSize);
        Move(Buffer^,Result[0],BufSize);
    except
        on E:Exception do
            SfRaiseException(E,'Exception raised in DecompressBytes call');
    end;
    
    //由于try...except块中重引发了异常，所以在发生了异常的情况下，以下的代码不会执行
    FreeMem(Buffer);
end;

看了压缩和解压字节数组的代码就会明白，直接使用函数避免了构造对象和销毁对象的开销