procedure ShellCopy(const dir1:string; const dir2:string); /////格式shellcopy('d:/1/*.*','e:/1/');///windows外壳拷贝
var
f:TSearchRec;
na,sdir:string;
s:tstringlist;
i:integer;
fshell:TSHFileOpStruct;
begin
s:=tstringlist.Create;
//////////////////////
if (not DirectoryExists(dir2)) then CreateDir(dir2);
sdir:=dir1;
delete(sdir,length(sdir)-2,3);
if FindFirst(dir1,faAnyFile,f)=0 then
begin
if (f.Name<>'database.dat') and (f.Attr<>faDirectory) then
begin s.Add(f.Name) end;
repeat
na:=f.Name;
FindNext(f);
if (na<>f.Name) and (f.Name<>'database.dat') and (f.Attr<>faDirectory) then
begin s.Add(f.Name); end;
until na=f.Name;
end;
//////////////////////
fshell.Wnd:=form1.Handle;
fshell.wFunc:=FO_COPY;
fshell.fFlags:=FOF_SILENT;
for i:=0 to s.Count-1 do
begin
fshell.pFrom:=pansichar(sdir+s.Strings[i]);
fshell.pTo:=pansichar(dir2+s.strings[i]);
SHFileOperation(fshell);
end;
end;
var
f:TSearchRec;
na,sdir:string;
s:tstringlist;
i:integer;
fshell:TSHFileOpStruct;
begin
s:=tstringlist.Create;
//////////////////////
if (not DirectoryExists(dir2)) then CreateDir(dir2);
sdir:=dir1;
delete(sdir,length(sdir)-2,3);
if FindFirst(dir1,faAnyFile,f)=0 then
begin
if (f.Name<>'database.dat') and (f.Attr<>faDirectory) then
begin s.Add(f.Name) end;
repeat
na:=f.Name;
FindNext(f);
if (na<>f.Name) and (f.Name<>'database.dat') and (f.Attr<>faDirectory) then
begin s.Add(f.Name); end;
until na=f.Name;
end;
//////////////////////
fshell.Wnd:=form1.Handle;
fshell.wFunc:=FO_COPY;
fshell.fFlags:=FOF_SILENT;
for i:=0 to s.Count-1 do
begin
fshell.pFrom:=pansichar(sdir+s.Strings[i]);
fshell.pTo:=pansichar(dir2+s.strings[i]);
SHFileOperation(fshell);
end;
end;
该示例展示了如何使用 Delphi 实现目录及其文件的复制操作。通过遍历指定源目录下的所有文件,并利用 Windows 外壳 API 进行静默复制到目标目录。特别地,此过程会忽略名为 'database.dat' 的文件及所有子目录。
1779

被折叠的 条评论
为什么被折叠?



