procedure DoZip(SourceDir:
string; ZipFile: TZipFile; DestDir:
string);
var
FileName:
String;
function FileInUse(FileName:
string): Boolean;
var
hFileRes: hFILE;
begin
Result := False;
if not FileExists(FileName)
then
exit;
hFileRes := CreateFile(PChar(FileName), GENERIC_READ
or GENERIC_WRITE, 0,
nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
Result := (hFileRes = INVALID_HANDLE_VALUE);
if not Result
then
CloseHandle(hFileRes);
end;
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 FileInUse(RealDir + FileName)
then
begin
CopyFile(PWideChar(RealDir + FileName), PWideChar(DestDir + FileName), False);
ZipFile.Add(DestDir + FileName, ZipDir + FileName, zcStored);
DeleteFile(PWideChar(DestDir + FileName));
end
else
ZipFile.Add(RealDir + FileName, ZipDir + FileName, zcstored);
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;