您的位置:首页 > 编程语言 > Delphi

delphi中基于内存流压缩和解压多个文件的经验

2011-06-26 11:38 429 查看
今天在工作中需要解决这样一个问题:压缩和解压一个文件,其中所有的过程都是基于内存中进行的。因为这个原因,基本的压缩工作比如说ZIPLIB等都不能使用。后来从网上找到了这样一段代码。

procedure CompressIt(var CompressedStream: TMemoryStream; const CompressionLevel: TCompressionLevel);
// 参数是传递的流和压缩方式
var
SourceStream: TCompressionStream;
DestStream: TMemoryStream;
Count: int64; //注意,此处修改了,原来是int
begin
//获得流的原始尺寸
Count := CompressedStream.Size;
DestStream := TMemoryStream.Create;
SourceStream := TCompressionStream.Create(CompressionLevel, DestStream);
try
//SourceStream中保存着原始的流
CompressedStream.SaveToStream(SourceStream);
//将原始流进行压缩, DestStream中保存着压缩后的流
SourceStream.Free;
CompressedStream.Clear;
//写入原始图像的尺寸
CompressedStream.WriteBuffer(Count, SizeOf(Count));
//写入经过压缩的流
CompressedStream.CopyFrom(DestStream, 0);
finally
DestStream.Free;
end;
end;
procedure UnCompressit(const CompressedStream: TMemoryStream; var UnCompressedStream: TMemoryStream);
//参数    压缩过的流,解压后的流
var
SourceStream: TDecompressionStream;
DestStream: TMemoryStream;
Buffer: PChar;
Count: int64;
begin
//从被压缩的图像流中读出原始的尺寸
CompressedStream.ReadBuffer(Count, SizeOf(Count));
//根据尺寸大小为将要读入的原始流分配内存块
GetMem(Buffer, Count);
DestStream := TMemoryStream.Create;
SourceStream := TDecompressionStream.Create(CompressedStream);
try
//将被压缩的流解压缩,然后存入 Buffer内存块中
SourceStream.ReadBuffer(Buffer^, Count);
//将原始流保存至 DestStream流中
DestStream.WriteBuffer(Buffer^, Count);
DestStream.Position := 0; //复位流指针
//  DestStream.Position := length(VER_INFO);
//从 DestStream流中载入图像流
UnCompressedStream.LoadFromStream(DestStream);
finally
FreeMem(Buffer);
DestStream.Free;
end;
end;


后来因为需求的改变,也是基于内存但是需要一次压缩和解压多个文件。以上的方法就不适用了。在这个过程中我网上搜索到ZIPFORG可以解决这个问题。于是下载了ZIPFORGE

function CompressitMultiFileByZipforge(str_needtocompress_filenamelist: TStringList; str_zip_file_name: string):Boolean;
var
my_ms, my_dest: TMemoryStream;
strZipFile, str_cur_file_name, str_file_name: string;
my_ZipForge: TZipForge;
i, i_file_count: Integer;
is_ok :Boolean;
begin
strZipFile := str_zip_file_name;
my_ZipForge := TZipForge.Create(nil);
i_file_count := str_needtocompress_filenamelist.Count;
my_ms := TMemoryStream.Create;
my_dest := TMemoryStream.Create;
is_ok := True;
try
begin
//my_ZipForge.FileName := strZipFile;
my_ZipForge.InMemory := True;//如果是基于内存流很重要
my_ZipForge.OpenArchive(my_dest, True);
if i_file_count = 0 then
begin
is_ok := False;
end
else
begin
for i := 0 to i_file_count - 1 do
begin
str_file_name := str_needtocompress_filenamelist.Strings[i];
str_cur_file_name := gHidePathPrefix + str_file_name;
my_ms := GetMemoryStreamByFileName(str_cur_file_name);
if my_ms.Size <> 0 then
begin
my_ZipForge.AddFromStream(str_file_name, my_ms, True);
end;
my_ms.Clear;
end;
if my_dest.Size <> 0 then
begin
DM.LionSunMANET.DiskManage.SaveFile(str_zip_file_name, my_dest);
is_ok := True;
end
else
begin
is_ok := False;
end;
end;
my_ms.Clear;
my_dest.Clear;
my_ZipForge.CloseArchive;
end
finally
begin
my_ms.Free;
my_dest.Free;
end;
end;
end;


解压的部分代码如下:

function DeCompressSingleZipFileByZipforge(str_needtodecompress_filename:string;str_zip_file_name:string):Boolean;
var
my_ms, my_dest: TMemoryStream;
strZipFile, str_dest_file_name, str_file_name: string;
my_ZipForge: TZipForge;
is_ok :Boolean;
begin
strZipFile := str_zip_file_name;
my_ZipForge := TZipForge.Create(nil);
my_ms := TMemoryStream.Create;
my_dest := TMemoryStream.Create;
is_ok := True;
try
begin
// Zip文件的文件名
if DM.LionSunMANET.DiskManage.ReadFile(strZipFile,my_ms) = 1 then
begin
//my_ZipForge.FileName := strZipFile;
my_ZipForge.InMemory := True;//关键
// 打开压缩文档
my_ZipForge.OpenArchive(my_ms,False);//关键
str_file_name := str_needtodecompress_filename;
my_ZipForge.ExtractToStream(str_file_name,my_dest);
str_dest_file_name := gHidePathPrefix + str_file_name;
my_dest.Position := 0;
DM.LionSunMANET.DiskManage.SaveFile(str_dest_file_name,my_dest);
my_dest.Clear;
// 关闭压缩文档
my_ms.Clear;
my_ZipForge.CloseArchive;
is_ok := True;
end
else
begin
my_dest.Clear;
my_ms.Clear;
is_ok := False;
end;
end;
finally
begin
my_ms.Free;
my_dest.Free;
end;
end;
Result := is_ok;
end;
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: 
相关文章推荐