例：多个目录下多个文件压缩到一个文件；
对压缩文件解压到个对应目录。
//压缩文件流: 文件名长度 + 文件名 + 文件长度 + 压缩流
uses Lh5Unit.pas; //见 数据压缩 -- 源码
procedure Compress;
var
fOutStr: TFileStream; //压缩文件流
function doOneFile(srcFile:string):boolean; //把一个文件压缩到 压缩文件流
var fInStr: TFileStream;
fTmp:TmemoryStream;
fnLen,sz:integer;
begin
result:=true;
if not fileExists(srcFile) then exit;
try
fInStr := TFileStream.Create(srcFile,fmOpenRead);
fTmp := TmemoryStream.create;
try
//在目标流 插入文件名长度 ,文件名，文件长度
fnLen :=length(srcFile);
fOutStr.Write(fnLen,sizeof(integer)); //文件名长度 // 或 sizeof(I)
fOutStr.Write(pFileName[1],fnLen); //文件名
LHACompress(fInStr, fTmp); //压缩文件 到 TmemoryStream
sz:=fTmp.Size ;
fOutStr.Write(sz,sizeof(integer)); //文件压缩长度
fOutStr.write(fTmp.Memory^,sz); //压缩流
finally
fInStr.Free;
fTmp.free;
end;
except
result:=false;
end;
end;
var
lhFile,aFileName:string;
begin
result:=true;
try
lhFile:=ExtractFilePath(application.ExeName)+'filePack.LHZ'; //压缩文件名
if fileExists(lhFile) then DeleteFile(lhFile);
fOutStr := TFileStream.Create(lhFile,fmCreate);
try
..... //检索要压缩的文件列表
openSQL('select HtmFile from FAQ where Flags=1 order by HtmFile',data.tbLHZ);
while not data.tbLHZ.eof do
begin
aFileName:='FAQfile\'+data.tbLHZ.FieldByname('HtmFile').asString+'.html';
if not doOneFile(ExtractFilePath(application.ExeName)+aFileName,aFileName) then
begin
result:=false; //压缩不成功
break;
end;
data.tbLHZ.next;
end;
finally
fOutStr.Free;
end;
except
result:=false; //压缩不成功
end;
end;
function Expand(lhFile:string): boolean;
var
Src_f:Tfilestream;
function getOneFile(aFileLen:integer;tFileName:string):boolean;
var
dst_f:Tfilestream;
Mem_f:TmemoryStream;
begin
result:=true;
try
if fileExists(tFileName) then deletefile(aFile); //已存在，覆盖它
dst_f := Tfilestream.create(aFile,fmcreate or fmopenwrite);
Mem_f := TmemoryStream.create;
try
if Mem_f.CopyFrom(src_f,aFileLen)<>aFileLen then raiselastWin32Error; //获取压缩流
Mem_f.position := 0;
LHAExpand(Mem_f,dst_f); //解压
finally
dst_f.free;
Mem_f.free;
end;
except
result:=false;
end;
end;
var
aFileName:string;
fnlen,fSize:integer;
begin
if not fileExists(lhFile) then exit; //压缩文件不存在! filePack.LHZ
result:=true;
try
src_f := TFileStream.Create(lhFile,fmOpenRead);
//从临时文件中分离出所有文件的实体
//src_f 源文件流: 文件名长度 + 文件名 + 文件压缩长度 + 压缩流(被压文件)
try
src_f.position := 0;
while true do begin
if src_f.size <=src_f.position+1 then break; //(2.0)如果 iRtn<=0 则文件流读取结束
if src_f.Read(fnlen,sizeof(integer))<=0 then break; //(2.1)取得文件名长度
setLength(aFileName,fnlen);
if src_f.Read(aFileName[1],fnlen)<=0 then break; //(2.2)取得文件名
if src_f.Read(fSize,sizeof(integer))<=0 then break; //(2.3)取得压缩长度
if getOneFile(fSize,aFileName) then //(2.4)获取压缩文件
begin
frmMsg.moMsgs.lines.add(aFileName+' 解压缩成功!'); frmMsg.Update ;
end else
begin
frmMsg.moMsgs.lines.add(aFileName+' 解压缩不成功!'); frmMsg.Update ;
end;
end;
finally
src_f.free;
end;
except
result:=false;
end;
end; 
|
本类阅读TOP10