delphi压缩与解压_不需要特别的控件

2018-10-31

delphi压缩与解压,比较简单,也比较实用,对我来说已经足够,我只想让客户端下载一个压缩文件到本地后解压出来就行,看网上有用什么控件的,我的是delphi6没装那控件,在公司管的比较严,要装控件比较麻烦。不扯了,看代码吧。


unit unzip;


interface


uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;


type

  TForm1 = class(TForm)

    Button1: TButton;

    Button2: TButton;

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;


var

  Form1: TForm1;


implementation


{$R *.dfm}


uses Zlib;

//压缩函数

procedure Zip(var fs: TMemoryStream);

var

  cs: TCompressionStream;

  ms: TMemoryStream;

  num: Integer;

begin

  if not(Assigned(fs) and (fs.Size>0)) then Exit;


    num := fs.Size;

    ms := TMemoryStream.Create;

    cs := TCompressionStream.Create(clMax, ms);

  try

    fs.SaveToStream(cs);

    cs.Free;

    //ms.Position := 0;

    fs.Clear;

    fs.WriteBuffer(num, sizeof(num));

    fs.CopyFrom(ms, 0);

  finally

    ms.Free;

  end;

end;


//解压函数

procedure UnZip2(var fs: Tmemorystream);

var

  ds: TDecompressionStream;

  ms: TMemoryStream;

  num: Integer;

begin

  if not(Assigned(fs) and (fs.Size>0)) then Exit;


  fs.Position := 0;

  fs.ReadBuffer(num,sizeof(num));

  ms := TMemoryStream.Create;

  ds := TDecompressionStream.Create(fs);

  try

    ms.SetSize(num);

    ds.Read(ms.Memory^, num);

    //ms.Position := 0;

    fs.Clear;

    fs.CopyFrom(ms, 0);

  finally

    ds.Free;

    ms.Free;

  end;

end;

//压缩测试

procedure TForm1.Button1Click(Sender: TObject);

var

  ms: TMemoryStream;

begin

ms := TMemoryStream.Create;

  ms.LoadFromFile('D:\delphi\szcb.mdb');

  Zip(ms);

  ms.SaveToFile('D:\delphi\szcb.zip');

end;


//解压测试

procedure TForm1.Button2Click(Sender: TObject);

var

  ms: TMemoryStream;

begin

  ms := TMemoryStream.Create;

  ms.LoadFromFile('D:\delphi\szcb.zip');

  UnZip2(ms);

  ms.SaveToFile('D:\delphi\szcb2.mdb');

end;


end.


阅读64