...
procedure DoZip(SourceDir:
string; ZipFile: TZipFile);
var
FileName:
String;
procedure ZipFiles(RealDir, ZipDir:
string);
var
E: Integer;
sr: TSearchRec;
begin
ZipDir := StringReplace(RealDir, ZipDir, '
', []);
E := FindFirst(RealDir + '
*.*', (faAnyFile
and not faDirectory), sr);
while E = 0
do
begin
if (sr.Attr
and faDirectory) = 0
then
begin
FileName := sr.
Name;
if RealDir + FileName <> ParamStr(0)
then
ZipFile.Add(RealDir + FileName, ZipDir + FileName);
end;
E := FindNext(sr);
end;
FindClose(sr);
end;
procedure ZipPath(RealDir, ZipDir:
string);
var
E: Integer;
sr: TSearchRec;
F: Boolean;
begin
RealDir := RealDir + '
\';
if ZipDir = '
'
then
begin
ZipDir := RealDir;
E := Length(ZipDir);
F := True;
while (E > 0)
and ((Copy(ZipDir, E, 1) <> '
\'))
or (F)
do
begin
Delete(ZipDir, E, 1);
Dec(E);
F := False;
end;
end;
E := FindFirst(RealDir + '
*.*', faDirectory, sr);
while E = 0
do
begin
if (sr.Attr
and faDirectory) = faDirectory
then
begin
FileName := sr.
Name;
if (FileName <> '
.')
and (FileName <> '
..')
then
begin
ZipPath(RealDir + FileName, ZipDir);
end;
end;
E := FindNext(sr);
end;
FindClose(sr);
ZipFiles(RealDir, ZipDir);
end;
begin
ZipPath(SourceDir, '
');
end;
...
FN := DestPath + '
\' + '
xxx.zip';
ZipFile := TZipFile.Create;
ZipFile.Open(FN, zmWrite);
DoZip(SourcePath, ZipFile);
ZipFile.Close;
FreeAndNil(ZipFile);
...