关于 Delphi 中流的使用(8) 压缩与解压缩的函数

 unit Unit1;

interfaceuses  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); 

end;

var  Form1: TForm1;

implementation

{$R *.dfm}

uses Zlib;/

/压缩函数

procedure Zip(var fs: TMemoryStream);

var  cs: TCompressionStream;  ms: TMemoryStream;  num: Integer;

begin 

ifnot(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 UnZip(var fs: Tmemorystream);

var  ds: TDecompressionStream;  ms: TMemoryStream;  num: Integer;

begin 

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

  fs.Position :=0;  f

s.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('c:\temp\test.txt'); 

Zip(ms); 

 ms.SaveToFile('c:\temp\test.zipx');

end;

//解压测试

procedure TForm1.Button2Click(Sender: TObject);

var  ms: TMemoryStream;

begin  ms := TMemoryStream.Create; 

 ms.LoadFromFile('c:\temp\test.zipx'); 

 UnZip(ms); 

 ms.SaveToFile('c:\temp\test2.txt');

end;

end.