unitcompr.pas

文件解压缩,大家学习一下

unit UnitCompr;

interface

uses
  Classes,sysutils,forms;
//  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
//  stdCtrls, FileCtrl;

type
  TCompressProgressEvent = procedure (Sender: TObject; Progress:Integer) of object;
  TAlloc = function (AppData: Pointer; Items, Size: Integer): Pointer;
  TFree = procedure (AppData, Block: Pointer);

  TZStreamRec = packed record
    next_in: PChar;       // next input byte
    avail_in: Integer;    // number of bytes available at next_in
    total_in: Integer;    // total nb of input bytes read so far

    next_out: PChar;      // next output byte should be put here
    avail_out: Integer;   // remaining free space at next_out
    total_out: Integer;   // total nb of bytes output so far

    msg: PChar;           // last error message, NULL if no error
    internal: Pointer;    // not visible by applications

    zalloc: TAlloc;       // used to allocate the internal state
    zfree: TFree;         // used to free the internal state
    AppData: Pointer;     // private data object passed to zalloc and zfree

    data_type: Integer;   //  best guess about the data type: ascii or binary
    adler: Integer;       // adler32 value of the uncompressed data
    reserved: Integer;    // reserved for future use
  end;
  TCompressCtrl=Class(TComponent)
  private
    FOnProgress: TCompressProgressEvent;
    Procedure DoProgress(Progress:Integer;Message:String);
  Public
    Function Backup(Source:TMemoryStream;Target:TMemoryStream): boolean;
    Function Restore(Source:TMemoryStream;Target:TMemoryStream): boolean;
    Property OnProgress:TCompressProgressEvent Read FOnProgress Write FOnProgress;
  end;

implementation
uses UnitProg;
Var
  FFormProgr:TFormProgr;
Const
  zlib_Version = '1.0.4';
  Z_NO_COMPRESSION       =   0;
  Z_BEST_SPEED           =   1;
  Z_BEST_COMPRESSION     =   9;
  Z_DEFAULT_COMPRESSION  = (-1);
  Z_FINISH        = 4;
  Z_STREAM_END    = 1;
{$L deflate.obj}
{$L inflate.obj}
{$L inftrees.obj}
{$L trees.obj}
{$L adler32.obj}
{$L infblock.obj}
{$L infcodes.obj}
{$L infutil.obj}
{$L inffast.obj}
procedure inflate_trees_bits; external;
procedure inflate_trees_dynamic; external;
procedure inflate_trees_fixed; external;
procedure inflate_trees_free; external;
procedure _memset(P: Pointer; B: Byte; count: Integer);cdecl;
begin
  FillChar(P^, count, B);
End;
procedure _memcpy(dest, source: Pointer; count: Integer);cdecl;
begin
  Move(source^, dest^, count);
End;
function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar; recsize: Integer): Integer; external;
function deflate(var strm: TZStreamRec; flush: Integer): Integer; external;
function deflateEnd(var strm: TZStreamRec): Integer; external;
function inflateInit_(var strm: TZStreamRec; version: PChar; recsize: Integer): Integer; external;
function inflate(var strm: TZStreamRec; flush: Integer): Integer; external;
function inflateEnd(var strm: TZStreamRec): Integer; external;
function inflateReset(var strm: TZStreamRec): Integer; external;
function zlibAllocMem(AppData: Pointer; Items, Size: Integer): Pointer;
begin
  GetMem(Result, Items*Size);
End;
procedure zlibFreeMem(AppData, Block: Pointer);
begin
  FreeMem(Block);
End;

//备份(压缩)过程。
//参数：Target:TMemoryStream输出流.
//      Source:TMemoryStream输入流。
//返回值：True正确完成保存。False保存过程出错。
//注：压窗前，先对输入流赋值。
Function TCompressCtrl.Backup(Source:TMemoryStream;Target:TMemoryStream): boolean;
Type TCompressionLevel = (clFastest, clNone, clDefault, clMax);
const
  iBufferSize = 16384;
var
  iSize,SourceSize                         : Longint;
  InBuffer                      :array[0..iBufferSize-1] of Byte;
  OutBuffer                     :array[0..iBufferSize-1] of Byte;
  CompressedSize, BytesRead: Integer;
  FZRec                         : TZStreamRec;
  IsCompressed          : boolean;
begin
  try
    Source.Seek(0,0);
    Target.Clear;
    SourceSize:=Source.Size;
    iSize := Source.Size;
    while (iSize > 0) do
    begin
      BytesRead := Source.Read(InBuffer, iBufferSize);
      //从源流中读入iBufferSize个字节的数据到InBuffer中.
      dec(iSize, BytesRead);
      //将总长度减去读出的长度!
      FillChar(FZRec, sizeof(FZRec), 0);
      //分配内存
      FZRec.zalloc := zlibAllocMem;
      FZRec.zfree := zlibFreeMem;
      FZRec.next_out := @OutBuffer;
      FZRec.avail_out := sizeof(OutBuffer);
      if deflateInit_(FZRec, Z_DEFAULT_COMPRESSION, zlib_version, sizeof(FZRec)) < 0 then
        IsCompressed:=False
      else
      begin
        FZRec.next_in := @InBuffer;
        FZRec.avail_in := BytesRead;
        IsCompressed:=deflate(FZRec, Z_FINISH)=Z_STREAM_END;
      end;
      if IsCompressed then//资料成功压缩
      begin
        CompressedSize := FZRec.total_out;
        Target.WriteBuffer(CompressedSize, SizeOf(CompressedSize));
        //记录资料长度!
        Target.Write(OutBuffer, CompressedSize);
        //将压缩资料写入输出流!
      End else//资料没有压缩
      begin
        CompressedSize := BytesRead * (-1);
        //负数表示没有压缩！
        Target.WriteBuffer(CompressedSize, SizeOf(CompressedSize));
        //记录资料长度!
        Target.Write(InBuffer, BytesRead);
        //将未压缩资料写入输出流!
      End;
      deflateEnd(FZRec);
      DoProgress(Trunc((SourceSize-iSize)/SourceSize*100),'正在压缩数据。。。');
    End;
    CompressedSize:=0;
    Target.WriteBuffer(CompressedSize,SizeOf(CompressedSize));
    //写入一个0作为结束标志。
    Result:=True;
  Except
    On E:Exception do
    begin
//      ShowMessage(E.Message);
      Result:=False;
    end;
  End;
  Target.Seek(0,0);
  DoProgress(-1,'正在压缩数据。。。');
End;

//恢复(解压缩)过程。
//参数：Target:TMemoryStream输出流.
//      Source:TMemoryStream输入流。
//返回值：True正确完成保存。False保存过程出错。
//注：解压缩前，先从文件流中读出原始数据。
procedure TCompressCtrl.DoProgress(Progress: Integer;Message:String);
begin
  if Assigned(FOnProgress) then
    FOnProgress(Self,Progress)
  else
  begin
    if Progress<>-1 then
    begin
      if not Assigned(FFormProgr) then
        FFormProgr:=TFormProgr.Create(Self);
      if not FFormProgr.Visible then
        FFormProgr.Show;
      FFormProgr.Progress:=Progress;
      FFormProgr.Message:=Message;
      Application.ProcessMessages;
    end else
    begin
      if Assigned(FFormProgr) then
      begin
        FFormProgr.Free;
        FFormProgr:=nil;
      end;
    end;
  end;
end;

Function TCompressCtrl.Restore(Source:TMemoryStream;Target:TMemoryStream): boolean;
Type TCompressionLevel = (clFastest, clNone, clDefault, clMax);
const
  iBufferSize = 16384;
var
  iSize, CompressedSize,UnCompressedSize,Progress,SourceSize         : Longint;
  InBuffer                      :array[0..iBufferSize-1] of Byte;
  OutBuffer                     :array[0..iBufferSize-1] of Byte;
  FZRec                         : TZStreamRec;
  IsError          : boolean;
begin
  IsError:=False;
  try
    SourceSize:=Source.Size;
    Source.Seek(0,0);
    Target.Clear;
    iSize := -1;
    Progress:=0;
    while (iSize <> 0) do
    begin
      Source.ReadBuffer(iSize, SizeOf(iSize));
      //从源流中读入一个整数表示这一组压缩数据的长度，如果这个数字是0表示解压完成。.
      CompressedSize:=ABS(iSize);
      Inc(Progress,SizeOf(CompressedSize));
      Source.Readbuffer(InBuffer, CompressedSize);  //读文件
      Inc(Progress,CompressedSize);
      if iSize>0 then
      begin
        FillChar(FZRec,sizeof(FZRec),0);
        FZRec.ZAlloc:=zlibAllocMem;
        FZRec.ZFree:=zlibFreeMem;
        FZRec.Next_in:=@OutBuffer;
        FZRec.Avail_In:=0;
        if inflateInit_(FZRec,zlib_version,sizeof(FZRec))<0 then
          IsError:=false;
        FZRec.Next_in:=@InBuffer;
        FZRec.Avail_In:=CompressedSize;
        FZRec.Next_Out:=@OutBuffer;
        FZRec.Avail_Out:=iBufferSize;
        if inflate(FZRec,0)<0 then
          IsError:=false;
        If not isError then
        begin
          UnCompressedSize:=FZRec.Total_Out;
          Target.Write(OutBuffer,UnCompressedSize);
        End else
          Target.Write(InBuffer, CompressedSize);
        inflateEnd(FZRec);
      end else if iSize<0 then
        Target.Write(InBuffer, CompressedSize);
      DoProgress(Trunc(Progress/SourceSize*100),'正在解压缩数据。。。');
    End;
    Result:=True;
  Except
    On E:Exception do
    begin
//      ShowMessage(E.Message);
      Result:=False;
    end;
  End;
  Target.Seek(0,0);
  DoProgress(-1,'正在解压缩数据。。。');
End;

end.