unit1.~pas

zlib的文件压缩演示

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,zlib,  StdCtrls;

type
  TForm1 = class(TForm)
    Button3: TButton;
    Button4: TButton;
    Edit1: TEdit;
    Button1: TButton;
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
procedure ys_stream(instream, outStream: TStream;ysbz:integer);
{
instream： 待压缩的已加密文件流
outStream  压缩后输出文件流
ysbz:压缩标准
}
var
 ys: TCompressionStream;
begin
 //流指针指向头部
 inStream.Position := 0;
 //压缩标准的选择
 case ysbz of
 1:  ys := TCompressionStream.Create(clnone,OutStream);//不压缩
 2:  ys := TCompressionStream.Create(clFastest,OutStream);//快速压缩
 3:  ys := TCompressionStream.Create(cldefault,OutStream);//标准压缩
 4:  ys := TCompressionStream.Create(clmax,OutStream); //最大压缩
 else

 ys := TCompressionStream.Create(clFastest,OutStream);
 end;

 try
   //压缩流
   ys.CopyFrom(inStream, 0);
 finally
   ys.Free;
 end;
end;



procedure jy_Stream(instream, outStream: TStream);
{
instream :原压缩流文件
outStream：解压后流文件
}
var
 jyl: TDeCompressionStream;
 buf: array[1..512] of byte;
 sjread: integer;
begin
 inStream.Position := 0;
 jyl := TDeCompressionStream.Create(inStream);
 try
   repeat
     //读入实际大小
     sjRead := jyl.Read(buf, sizeof(buf));
     if sjread > 0 then
       OutStream.Write(buf, sjRead);
   until (sjRead = 0);
 finally
   jyl.Free;
 end;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
zip_dest,ok,ok1: tmemorystream;
begin
zip_dest := tmemorystream.Create;
ok := tmemorystream.Create;
ok1 := tmemorystream.Create;
zip_dest.LoadFromFile('c:\a.zip');

jy_Stream (zip_dest,ok);
ok.SaveToFile('c:\ash.mht');
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  zip_dest,ok: tmemorystream;

begin
  zip_dest := tmemorystream.Create;
  ok := tmemorystream.Create;

  zip_dest.LoadFromFile('c:\aa.swf');
ys_stream(zip_dest,ok,4);
ok.SaveToFile('c:\aaa.zip');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ForceDirectories(edit1.Text);
end;

end.