例:多个目录下多个文件压缩到一个文件;
对压缩文件解压到个对应目录。
//压缩文件流: 文件名长度 + 文件名 + 文件长度 + 压缩流
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