例:多个目录下多个文件压缩到一个文件; 对压缩文件解压到个对应目录。 //压缩文件流: 文件名长度 + 文件名 + 文件长度 + 压缩流 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;
[Sql Server]Sql精妙语句--各种求值函数 [网页制作]网页表格之---多个表格纵向排列 [网页制作]JavaScript另类用法--读取和写入cookie [网页制作]号称非常安全的上网工具---360安全浏览器介绍 [办公软件]信息技术教学篇---Word工具栏的显示、隐藏及四种菜… [操作系统]开始菜单---运行命令大总结 [操作系统]网络转载---64位操作系统与32位的区别 [操作系统]ldap:///(没有响应)Windows无法访问指定设备、路径… [网络技术]安全篇---交换机设置方法介绍 [聊天工具]Real10 & Xpdf installation on Linux Box
|