{*--
ZLib压缩与解压的相关函数
@author xszlo
@version 1.0
@todo ZLib压缩与解压的相关函数
@History
20080311,xszlo,Create
--*}
unit uZLib;
interface
uses
Classes, SysUtils, ZLib;
//Input,Output 输入输出文件名
procedure ZipFile(Input, Output: string);
//流
procedure ZipStream(Input, Output: TStream);
//字符串
function ZipString(Input: string): string;
//
function ZipFileToString(Input: string): string;
//==============================================================================
// 将多个文件合并成一个文件，合成时将对每个子文件进行压缩处理
//==============================================================================
procedure CompressFiles(Files: TStrings; const Filename: string; ATmpDir: string = '');
//==============================================================================
// 将一个文件包中的文件拆分到一个目录中，支持返回子文件列表
//==============================================================================
procedure DecompressFiles(const Filename, DestDirectory: string; AFileList: TStringList = nil);
//==============================================================================
// 将一个文件包中的文件拆分到一个目录中，支持返回子文件列表 加密解密工厂专用
//==============================================================================
procedure DecompressFilesForEncy(const FileNum: Integer;
Filename, DestDirectory: string; AFileList: TStringList = nil);
//==============================================================================
// 判断是否有效的合成文件 加密解密工厂专用
//==============================================================================
function IsValidPDEFile(const FileNum: Integer; Filename: string): Boolean;
procedure UnZipFile(Input, Output: string);
procedure UnZipStream(Input, Output: TStream);
function UnZipString(Input: string): string;
procedure UnZipStringToFile(Input, Output: string);
implementation
uses uSystemFunc;
//==============================================================================
// 判断是否有效的合成文件 加密解密工厂专用
//==============================================================================
function IsValidPDEFile(const FileNum: Integer; Filename: string): Boolean;
var
infile: TFilestream;
c: Integer;
begin
infile := TFileStream.Create(Filename, fmOpenRead);
try
{ 获取子文件数 }
infile.Read(c, SizeOf(c));
Result := (c = FileNum);
finally
infile.Free;
end;
end;
//==============================================================================
// 将一个文件包中的文件拆分到一个目录中，支持返回子文件列表 加密解密工厂专用
//==============================================================================
procedure DecompressFilesForEncy(const FileNum: Integer; Filename, DestDirectory: string; AFileList: TStringList = nil);
var
dest, s: string;
decompr: TDecompressionStream;
infile, outfile: TFilestream;
i, l, c: Integer;
begin
dest := IncludeTrailingPathDelimiter(DestDirectory);
infile := TFileStream.Create(Filename, fmOpenRead);
try
{ 获取子文件数 }
infile.Read(c, SizeOf(c));
if c <> FileNum then
begin
Exit;
end;
for i := 1 to c do
begin
{ 获取文件名长度和文件名 }
infile.Read(l, SizeOf(l));
SetLength(s, l);
infile.Read(s[1], l);
{ 获取文件大小 }
infile.Read(l, SizeOf(l));
{解压子文件并且存储 }
s := dest + s;
if AFileList <> nil then
begin
AFileList.Add(s);
end;
outfile := TFileStream.Create(s, fmCreate);
decompr := TDecompressionStream.Create(infile);
try
outfile.CopyFrom(decompr, l);
finally
outfile.Free;
decompr.Free;
end;
end;
finally
infile.Free;
end;
end;
//==============================================================================
// 将一个文件包中的文件拆分到一个目录中，支持返回子文件列表
//==============================================================================
procedure DecompressFiles(const Filename, DestDirectory: string; AFileList: TStringList);
var
dest, s: string;
decompr: TDecompressionStream;
infile, outfile: TFilestream;
i, l, c: Integer;
begin
dest := IncludeTrailingPathDelimiter(DestDirectory);
infile := TFileStream.Create(Filename, fmOpenRead);
try
{ 获取子文件数 }
infile.Read(c, SizeOf(c));
for i := 1 to c do
begin
{ 获取文件名长度和文件名 }
infile.Read(l, SizeOf(l));
SetLength(s, l);
infile.Read(s[1], l);
{ 获取文件大小 }
infile.Read(l, SizeOf(l));
{解压子文件并且存储 }
s := dest + s;
if AFileList <> nil then
begin
AFileList.Add(s);
end;
outfile := TFileStream.Create(s, fmCreate);
decompr := TDecompressionStream.Create(infile);
try
outfile.CopyFrom(decompr, l);
finally
outfile.Free;
decompr.Free;
end;
end;
finally
infile.Free;
end;
end;
//==============================================================================
// 将多个文件合并成一个文件，合成时将对每个子文件进行压缩处理
//==============================================================================
procedure CompressFiles(Files: TStrings; const Filename: string; ATmpDir: string);
var
infile, outfile, tmpFile: TFileStream;
compr: TCompressionStream;
i, l: Integer;
s, sTmpGuid: string;
begin
if Files.Count > 0 then
begin
outFile := TFileStream.Create(Filename, fmCreate);
try
{ 待合并文件的数量 }
l := Files.Count;
outfile.Write(l, SizeOf(l));
for i := 0 to Files.Count - 1 do
begin
infile := TFileStream.Create(Files[i], fmOpenRead);
try
{ 获取原始文件名 }
s := ExtractFilename(Files[i]);
{ 获取原始文件名长度 }
l := Length(s);
{ 写入文件名长度 }
outfile.Write(l, SizeOf(l));
{ 写入文件名内容 }
outfile.Write(s[1], l);
{ 获取文件大小（字节数） }
l := infile.Size;
{ 写入文件大小（字节数） }
outfile.Write(l, SizeOf(l));
{ 压缩并存储文件内容 }
if ATmpDir <> '' then
sTmpGuid := IncludeTrailingPathDelimiter(ATmpDir) + MakeGUID
else
sTmpGuid := 'temp';
tmpFile := TFileStream.Create(sTmpGuid, fmCreate);
compr := TCompressionStream.Create(clMax, tmpfile);
try
compr.CopyFrom(infile, l);
finally
compr.Free;
tmpFile.Free;
end;
{ 将压缩文件添加写入目标文件流中 }
tmpFile := TFileStream.Create(sTmpGuid, fmOpenRead);
try
outfile.CopyFrom(tmpFile, 0);
finally
tmpFile.Free;
end;
finally
infile.Free;
end;
end;
finally
outfile.Free;
end;
DeleteFile(sTmpGuid);
end;
end;
procedure ZipFile(Input, Output: string);
var
InputFileStream, OutputFileStream: TFileStream;
begin
if not FileExists(Input) then
exit;
if FileExists(Output) then
DeleteFile(Output);
InputFileStream := TFileStream.Create(Input, fmOpenRead);
OutputFileStream := TFileStream.Create(Output, fmCreate);
try
ZipStream(InputFileStream, OutputFileStream);
finally
OutputFileStream.Free;
InputFileStream.Free;
end;
end;
procedure ZipStream(Input, Output: TStream);
const
MAXBUFSIZE = 1024 * 16; //16 KB
var
CS: TCompressionStream;
begin
if Assigned(Input) and Assigned(Output) then
begin
CS := TCompressionStream.Create(clDefault, Output);
try
CS.CopyFrom(Input, 0); //从开始处复制
finally
CS.Free;
end;
end;
end;
function ZipString(Input: string): string;
var
InputStream, OutputStream: TStringStream;
begin
if Input = '' then
Exit;
InputStream := TStringStream.Create(Input);
try
OutputStream := TStringStream.Create('');
try
ZipStream(InputStream, OutputStream);
Result := OutputStream.DataString;
finally
OutputStream.Free;
end;
finally
InputStream.Free;
end;
end;
procedure UnZipFile(Input, Output: string);
var
InputFileStream, OutputFileStream: TFileStream;
begin
if not FileExists(Input) then
exit;
if FileExists(Output) then
DeleteFile(Output);
InputFileStream := TFileStream.Create(Input, fmOpenRead);
OutputFileStream := TFileStream.Create(Output, fmCreate);
try
UnZipStream(InputFileStream, OutputFileStream);
finally
OutputFileStream.Free;
InputFileStream.Free;
end;
end;
procedure UnZipStream(Input, Output: TStream);
const
MAXBUFSIZE = 1024 * 16; //16 KB
var
DS: TDecompressionStream;
Buf: array[0..MAXBUFSIZE - 1] of Byte;
BufSize: Integer;
begin
if Assigned(Input) and Assigned(Output) then
begin
DS := TDecompressionStream.Create(Input);
try
BufSize := DS.Read(Buf, MAXBUFSIZE);
while BufSize > 0 do
begin
Output.Write(Buf, BufSize);
BufSize := DS.Read(Buf, MAXBUFSIZE);
end;
finally
DS.Free;
end;
end;
end;
function UnZipString(Input: string): string;
var
InputStream, OutputStream: TStringStream;
begin
if Input = '' then
Exit;
InputStream := TStringStream.Create(Input);
try
OutputStream := TStringStream.Create('');
try
UnZipStream(InputStream, OutputStream);
Result := OutputStream.DataString;
finally
OutputStream.Free;
end;
finally
InputStream.Free;
end;
end;
function ZipFileToString(Input: string): string;
var
InputFileStream: TFileStream;
OutputStringStream: TStringStream;
begin
if not FileExists(Input) then
exit;
Result := '';
InputFileStream := TFileStream.Create(Input, fmOpenRead);
OutputStringStream := TStringStream.Create('');
try
ZipStream(InputFileStream, OutputStringStream);
Result := OutputStringStream.DataString;
finally
OutputStringStream.Free;
InputFileStream.Free;
end;
end;
procedure UnZipStringToFile(Input, Output: string);
var
InputStringStream: TStringStream;
OutputFileStream: TFileStream;
begin
if not FileExists(Output) then
DeleteFile(Output);
InputStringStream := TStringStream.Create(Input);
OutputFileStream := TFileStream.Create(Output, fmCreate);
try
UnZipStream(InputStringStream, OutputFileStream);
finally
OutputFileStream.Free;
InputStringStream.Free;
end;
end;
end.
---------------
直接将下面的代码保存为：uZlib.pas
本文地址：http://www.xszlo.com/article/2012-12-13/7627.html，转发请保留这个地址，谢谢
