文档章节

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

涂孟超
 涂孟超
发布于 2014/09/26 15:36
字数 217
阅读 3
收藏 0
unit Unit1;

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);
  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 UnZip(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('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.

 
 
 
 
 

 

 

  

本文转载自:http://www.cnblogs.com/del/archive/2008/01/02/1023195.html

共有 人打赏支持
涂孟超
粉丝 12
博文 2011
码字总数 14107
作品 0
深圳
程序员
私信 提问
SQLite for Delphi的网友评论

SQLite的一个Delphi的开源封装库,全面支持Delphi 4, 5, 6, 7, 2005 和 2006。对于Delphi 4和Delphi 5请使用带有D4、D5后缀的文件。解压缩下载回来的文件包到Delphi的子目录下,安装该组件,...

红薯
2009/12/11
1K
2
SQLite for Delphi

SQLite的一个Delphi的开源封装库,全面支持Delphi 4, 5, 6, 7, 2005 和 2006。对于Delphi 4和Delphi 5请使用带有D4、D5后缀的文件。解压缩下载回来的文件包到Delphi的子目录下,安装该组件,...

匿名
2008/10/06
12.3K
1
关于文件操作集锦 delphi

关于文件操作集锦 取得该快捷方式的指向EXE 关键词:快捷方式 LNK unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCt......

vga
2014/04/23
0
0
ZIP文件格式详解

ZIP文件的总体格式 分文件头信息+文件压缩数据 中心目录+中心目录记录结束符 1.分文件头信息: 字节数 描述 4 分文件头信息标志(0x04034b50) 2 解压缩所需版本 2 通用比特标志位(置比特0位=加...

壶漏子
2015/10/09
1K
0
开发手记OSSC-阿里云开发存储服务(OSS)的C SDK

OSSC(Aliyun Open Storage Service C SDK)是我和实验室@王维同学在2012首届阿里云开发者大赛中的参赛项目(http://2012.aliyun.com),我们作品提交是在10月2号,但是11月8号才揭晓最终结果...

大卷卷
2012/10/22
0
0

没有更多内容

加载失败,请刷新页面

加载更多

大数据教程(6.1)hadoop生态圈介绍及就业前景

1. HADOOP背景介绍 1.1、什么是HADOOP 1.HADOOP是apache旗下的一套开源软件平台 2.HADOOP提供的功能:利用服务器集群,根据用户的自定义业务逻辑,对海量数据进行分布式处理 3.HADOOP的核心组...

em_aaron
41分钟前
1
0
hadoop垃圾回收站

在生产生,hdfs回收站必须是开启的,一般设置为7天。 fs.trash.interval 为垃圾回收站保留时间,如果为0则禁用回收站功能。 fs.trash.checkpoint.interval 回收站检查点时间,一般设置为小于...

hnairdb
昨天
1
0
腾讯与Github的魔幻会面背后的故事…

10月22日,腾讯开源管理办公室有幸邀请到Github新晋CEO Nat Friedman,前来鹅厂参观交流。目前腾讯已经有近70个项目在Github上开源,共获得17w stars,世界排名11位。Github是腾讯开源的主阵...

腾讯开源
昨天
7
0
单例模式

单例模式(Singleton pattern)属于创建型设计模式。 保证一个类仅有一个实例,并提供一个访问它的全局访问点。 通常我们可以让一个全局变量使得一个对象被访问,但它不能防止你实例化多个对...

NinjaFrog
昨天
2
0
TypeScript基础入门之装饰器(三)

转载 TypeScript基础入门之装饰器(三) 继续上篇文章[TypeScript基础入门之装饰器(二)] 访问器装饰器 Accessor Decorator在访问器声明之前声明。 访问器装饰器应用于访问器的属性描述符,可用...

durban
昨天
3
0

没有更多内容

加载失败,请刷新页面

加载更多

返回顶部
顶部