main.pas

多种算法压缩与解压缩方式

unit main;

interface

{*********************************************************************

压缩测试单元
作者：崔东伟
Email:[e-mail] 或 [e-mail]

发布这一文件的目的是希望它有用，但没有任何担保。甚至没有适合特定目的
而隐含的担保。作者不承担由此带来的任何问题

*********************************************************************}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons;
const
  BufferSize=2048;

type
  Tmainfm = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    GroupBox1: TGroupBox;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    GroupBox2: TGroupBox;
    BitBtn5: TBitBtn;
    BitBtn6: TBitBtn;
    GroupBox3: TGroupBox;
    BitBtn7: TBitBtn;
    BitBtn8: TBitBtn;
    GroupBox4: TGroupBox;
    BitBtn10: TBitBtn;
    BitBtn11: TBitBtn;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Memo1: TMemo;
    Label3: TLabel;
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  mainfm: Tmainfm;

implementation

{$R *.DFM}
uses
  lz77,arith,zlib,lh5unit;

  procedure ZCompress(InStr, OutStr: TStream);
  var
    Zstream:TCustomZlibStream;
    CompressionLevel:TCompressionLevel;
  begin
    CompressionLevel:=clMax;
    ZStream := TCompressionStream.Create(CompressionLevel, OutStr);
    try
      ZStream.CopyFrom(InStr, 0);
    finally
      ZStream.Free;
    end;
  end;

  procedure ZExpand(InStr, OutStr: TStream);
  var
    Zstream:TCustomZlibStream;
    Buffer : Array[0 .. BufferSize - 1] of Byte;
    count:integer;
  begin
    ZStream := TDecompressionStream.Create(InStr);
    try
      while True do
      begin
        Count := ZStream.Read(Buffer, BufferSize);
        if Count <> 0 then OutStr.WriteBuffer(Buffer, Count) else Break;
      end;
    finally
      ZStream.Free;
    end;
  end;

procedure Tmainfm.BitBtn3Click(Sender: TObject);
const
  cstr:array[1..8] of string=
  ('lz77Compress',
   'lz77Expand',
   'ArithCompress',
   'ArithExpand',
   'LHACompress',
   'LHAExpand',
   'ZCompress',
   'ZExpand');
var
  infn,outfn:string;
  infile,outfile:TStream;
begin
  infn:=Edit1.text;
  if not fileexists(infn) then
    raise exception.Create('源文件不存在!');
  outfn:=Edit2.text;
  if fileexists(outfn) then
  begin
    if application.messagebox('输出文件已经存在，要覆盖该文件吗?',
      '警告',MB_ICONQUESTION or MB_YESNO or MB_DEFBUTTON2)=IDNO then exit;
    deletefile(outfn);
  end;

  InFile := TFileStream.Create(infn, fmOpenRead);
  try
    OutFile := TFileStream.Create(outfn, fmCreate);
    try
      case TComponent(Sender).tag of
      1:lz77Compress(Infile,OutFile);
      2:lz77Expand(Infile,OutFile);
      3:ArithCompress(Infile,OutFile);
      4:ArithExpand(Infile,OutFile);
      5:LHACompress(Infile,OutFile);
      6:LHAExpand(Infile,OutFile);
      7:zCompress(Infile,OutFile);
      8:zExpand(Infile,OutFile);
      end;
      if TComponent(Sender).tag in [1,3,5,7] then
      memo1.Lines.add(format('%s 输入%d :bytes 输出:%d bytes 压缩比:%5.2f',
        [cstr[TComponent(Sender).tag],InFile.size,outfile.size,outfile.size*100/InFile.size])+'%')
      else
      memo1.Lines.add(format('%s 输入%d :bytes 输出:%d bytes 压缩比:%5.2f',
        [cstr[TComponent(Sender).tag],InFile.size,outfile.size,InFile.size*100/outfile.size])+'%');

    finally
      outfile.free;
    end;
  finally
    InFile.Free;
  end;
end;

procedure Tmainfm.BitBtn1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    edit1.Text:=OpenDialog1.FileName;
end;

procedure Tmainfm.BitBtn2Click(Sender: TObject);
begin
  if SaveDialog1.Execute then
    edit2.Text:=SaveDialog1.FileName;

end;

end.