本文整理自网络，侵删。
//zip 用的是 VCLUnZip, VCLZip 控件
//得到所有子目录列表
function GetAllSubDir(Directory: string; var RetList: TStringList): Boolean;
//得到所有子目录文件列表
function GetAllDirFile(Directory: string; var RetList: TStringList): Boolean;
//压缩一个目录
function ZipDir(sDir, sFile: string): Boolean;
//解压一个目录
function UnZipDir(sFile, sDir: string): Boolean;
//压缩,解压缩文件>
function GetAllSubDir(Directory: string; var RetList: TStringList): Boolean;
var
SearchRec: TSearchRec;
sTemp: string;
function IsSubDir(SearchRec: TSearchRec): Boolean;
begin
if (SearchRec.Attr = faDirectory) and (SearchRec.Name <> '.') and
(SearchRec.Name <> '..') then
Result := True
else
Result := False;
end;
begin
if FindFirst(Directory + '*.*', faAnyFile, SearchRec) = 0 then
begin
repeat //循环直到Until为真
if IsSubDir(SearchRec) then
begin
sTemp := Directory + SearchRec.Name + '\';
RetList.Add(sTemp);
GetAllSubDir(sTemp, RetList); //这是递归部分，查找各子目录。
end;
until (FindNext(SearchRec) <> 0);
end;
FindClose(SearchRec);
Result := True;
end;
function GetAllDirFile(Directory: string; var RetList: TStringList): Boolean;
var
i: Integer;
DirList: TStringList;
SearchRec: TSearchRec;
begin
Result := False;
DirList := TStringList.Create;
DirList.Add(Directory + '\');
if not GetAllSubDir(Directory + '\', DirList) then exit;
for i := 0 to DirList.Count - 1 do
begin
if FindFirst(DirList.Strings[i] + '*.*', faAnyFile, SearchRec) = 0 then
begin
repeat //循环直到Until为真
if SearchRec.Attr <> faDirectory then
RetList.Add(DirList.Strings[i] + SearchRec.Name);
until (FindNext(SearchRec) <> 0);
end;
end;
if DirList.Count <= 0 then
RetList.Add(Directory);
DirList.Free;
Result := True;
end;
function ZipDir(sDir, sFile: string): Boolean;
var
VCLZip1: TVCLZip;
RetList: TStringList;
begin
Result := True;
VCLZip1 := TVCLZip.Create(nil);
RetList := TStringList.Create;
GetAllDirFile(sDir, RetList);
with VCLZip1 do
begin
FilesList := RetList;
ZipName := sFile;
RelativePaths := True; //相对目录
// StorePaths := True; //存储目录
end;
VCLZIP1.RootDir := SDIR; //根目录
// VCLZip1.Destdir := sDir; //目标目录
// Screen.Cursor := crHourglass;
try
VCLZip1.Zip;
except
Result := False;
end;
// Screen.Cursor := crDefault;
RetList.Free;
VCLZip1.Free;
end;
function UnZipDir(sFile, sDir: string): Boolean;
var
VCLUnZip1: TVCLUnZip;
begin
Result := True;
VCLUnZip1 := TVCLUnZip.Create(nil);
with VCLUnZip1 do
begin
ZipName := sFile;
ReadZip;
Destdir := sDir;
RecreateDirs := True;
FilesList.Add('*.*');
DoAll := True;
OverwriteMode := Always;
end;
// Screen.Cursor := crHourglass;
try
VCLUnZip1.UnZip;
except
Result := False;
end;
//Screen.Cursor := crDefault;
VCLUnZip1.Free;
end;
//压缩,解压缩文件<
end.
-----------------------------------------------------------------------------------------------------------------------------------
Vclzip控件主要的类为TVclUnZip 和TVclZip 其中，TVclZip继承自TVclUnZip。
网上的转帖用法：
function Zip(ZipMode,PackSize:Integer;ZipFile,UnzipDir:String):Boolean; //压缩或解压缩文件
var ziper:TVCLZip;
begin
//函数用法：Zip(压缩模式，压缩包大小，压缩文件，解压目录)
//ZipMode为0：压缩；为1：解压缩 PackSize为0则不分包；否则为分包的大小
try
if copy(UnzipDir, length(UnzipDir), 1) = '\' then
UnzipDir := copy(UnzipDir, 1, length(UnzipDir) - 1); //去除目录后的“\”
ziper:=TVCLZip.Create(application); //创建zipper
ziper.DoAll:=true; //加此设置将对分包文件解压缩有效
ziper.OverwriteMode:=Always; //总是覆盖模式
if PackSize<>0 then begin //如果为0则压缩成一个文件，否则压成多文件
ziper.MultiZipInfo.MultiMode:=mmBlocks; //设置分包模式
ziper.MultiZipInfo.SaveZipInfoOnFirstDisk:=True; //打包信息保存在第一文件中
ziper.MultiZipInfo.FirstBlockSize:=PackSize; //分包首文件大小
ziper.MultiZipInfo.BlockSize:=PackSize; //其他分包文件大小
end;
ziper.FilesList.Clear;
ziper.ZipName := ZipFile; //获取压缩文件名
if ZipMode=0 then begin //压缩文件处理
ziper.FilesList.Add(UnzipDir+'\*.*'); //添加解压缩文件列表
Application.ProcessMessages; //响应WINDOWS事件
ziper.Zip; //压缩
end else begin
ziper.DestDir:= UnzipDir; //解压缩的目标目录
ziper.UnZip; //解压缩
end;
ziper.Free; //释放压缩工具资源
Result:=True; //执行成功
except
Result:=False;//执行失败
end;
end;
制作带目录结构的压缩指定目录：
function AddZipFile(ZipFileName,FileName:pchar):integer;stdcall;
var
ziper:TVclZip;
begin
result:=0;
try
try
ziper:=TVclZip.Create(nil);
ziper.OverwriteMode:=Always;//总是覆盖
ziper.DoAll:=true;//压缩所有文件
ziper.RelativePaths:=true;//是否保持目录结构
ziper.AddDirEntriesOnRecurse:=true;
ziper.RecreateDirs:=true;//创建目录
ziper.StorePaths:=true;//保存目录信息
//ziper.Recurse:=true;
except
exit;
end;
if FileExists(StrPas(ZipFileName)) then
begin
if UnZipFile(ZipFileName,TempDir)=1 then
begin
ziper.FilesList.Add(TempDir+StrPas(ZipFileName)+'\*.*');
ziper.FilesList.Add(StrPas(FileName));
ziper.ZipName:=strpas(ZipFileName);
ziper.Zip;
result:=1;
end;
end
else
begin
ziper.FilesList.Add(FileName);
ziper.ZipName:=StrPas(ZipFileName);
ziper.zip;
result:=1;
end;
finally
ziper.Free;
end;
把指定目录（带子目录）的所有文件压缩到一个目录下：
function AddDirAll(Dir,ZipFileName:pchar):integer;stdcall;
var
Ziper:TVclZip;
FileRec: TSearchrec;
TempDir:String;
begin
if FindFirst(Strpas(Dir),faAnyFile,FileRec) = 0 then
begin
repeat
if (FileRec.Attr and faDirectory) <> 0 then
begin
TempDir:=StrPas(Dir)+'\'+FileRec.Name;
AddDirAll(PChar(TempDir),ZipFileName);
end;
if (FileRec.Attr and faAnyFile )<> 0 then
begin
result:=AddZipFile(ZipFileName,Pchar(TempDir+'\*.*'));
end;
until FindNext(FileRec) <> 0 ;
end;
end;
相关阅读 >>
Delphi string.split 按照任意字符串分割语句
Delphi idhttp post json 上传 php 接收
更多相关阅读请进入《Delphi》频道 >>
