注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

鑫淼梦园的博客

圆你的梦想 从这里开始

 
 
 

日志

 
 

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

2014-08-31 13:35:34|  分类: Delphi xe6 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
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. 
  评论这张
 
阅读(314)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017