请教：如何清空文件夹的所有文件？如何复制一文件夹的所有文件到另一文件夹？

Question

请教：如何清空文件夹的所有文件？如何复制一文件夹的所有文件到另一文件夹？  

Answer 1

参考下面代码，自己改一改就行了var
  DirInfo: TSearchRec;
  r: Integer;
begin
  if SaveDialog1.Execute then
  begin
    if CreateDir(SaveDialog1.FileName) = false then
      ShowMessage('不能创建目录:' + SaveDialog1.FileName);
    r := FindFirst(ExtractFilePath(Application.Exename) + 'dbf\*.*', FaAnyfile, DirInfo);
    while r = 0 do
    begin
      if ((DirInfo.Attr and FaDirectory <> FaDirectory) and
        (DirInfo.Attr and FaVolumeId <> FaVolumeID)) then
        CopyFile(pChar(ExtractFilePath(Application.Exename) + 'dbf\' + DirInfo.Name),
          pChar(SaveDialog1.FileName + '\' + DirInfo.Name), True);
      r := FindNext(DirInfo);
    end;
    SysUtils.FindClose(DirInfo);
  end;
end;

Answer 2

function deldir(mDirName:   string):   Boolean;
  var   
      vSearchRec:   TSearchRec;   
      vPathName:   string;   
      K:   Integer;   
  begin   
      Result   :=   True;   
      vPathName   :=   mDirName   +   '\*.*';   
      K   :=   FindFirst(vPathName,   faAnyFile,   vSearchRec);   
      while   K   =   0   do   begin   
          if   (vSearchRec.Attr   and   faDirectory   >   0)   and   
              (Pos(vSearchRec.Name,   '..')   =   0)   then   begin   
              FileSetAttr(mDirName   +   '\'   +   vSearchRec.Name,   faDirectory);   
              Result   :=   DeletePath(mDirName   +   '\'   +   vSearchRec.Name);   
          end   else   if   Pos(vSearchRec.Name,   '..')   =   0   then   begin   
              FileSetAttr(mDirName   +   '\'   +   vSearchRec.Name,   0);   
              Result   :=   DeleteFile(PChar(mDirName   +   '\'   +   vSearchRec.Name));   
          end;   
          if   not   Result   then   Break;   
          K   :=   FindNext(vSearchRec);   
      end;   
      FindClose(vSearchRec);   
      Result   :=   RemoveDir(mDirName);   
  end;procedure copydir (root: string,destdir:string);
var
  test_name: string;
  full_name: string;
  s: TSearchRec;
begin
test_name:='*.*';
  if stop_requested then Exit;
  root := LowerCase (root);
  if root [Length (root)] <> '\' then
     root := root + '\';
//      Application.ProcessMessages;
  if FindFirst (test_name, faAnyFile, s) = 0 then
         repeat
//               if stop_requested then Exit;
               with s do begin
                    Name := LowerCase (Name);
                    if (Attr <> faDirectory) then  begin
                        full_name := root + Name;
                        copyfile(full_name,destdir+name)
                    end;
               end;
         until FindNext (s) <> 0;
      FindClose (s);
  end;
  test_name := root + '*.*';
  if FindFirst (test_name, faAnyFile, s) = 0 then
     repeat
           with s do
                if ((Attr and faDirectory) <> 0) and ((Name <> '.') and (Name <> '..'))
                then copydir (root + Name,destdir+Name);
     until FindNext (s) <> 0;
  FindClose (s);
end;

Answer 3

路径最后不要带斜杠
function ClearDir(Dir: string): Boolean;
var
  fo: TSHFileOpStruct;
begin
  FillChar(fo, SizeOf(fo), 0);
  fo.pFrom := PChar(Dir + '\*.*' + #0);
  fo.wFunc := FO_DELETE;
  fo.fFlags := FOF_SILENT or FOF_NOCONFIRMATION;
  Result := SHFileOperation(fo) = 0;
end;function CopyDir(Sou, Des: string): Boolean;
var
  fo: TSHFileOpStruct;
begin
  FillChar(fo, SizeOf(fo), 0);
  fo.pFrom := PChar(Sou + '\*.*' + #0);
  fo.pTo := PChar(Des + #0);
  fo.wFunc := FO_COPY;
  fo.fFlags := FOF_SILENT or FOF_NOCONFIRMATION;
  Result := SHFileOperation(fo) = 0;
end;

Answer 4

function FileOperation(const AFromDir,ADestDir,Op:string):Boolean;
var
  FileOpStruct:TSHFileOpStruct;
  FromDir,DestDir:pchar;
begin
  Result:=False;
  GetMem(FromDir,length(AFromDir)+2);
  FillChar(FromDir^,length(AFromDir)+2,0);
  StrCopy(FromDir,pchar(AFromDir));
  if ADestDir<>'' then
  begin
    GetMem(DestDir,length(ADestDir)+2);
    FillChar(DestDir^,length(ADestDir)+2,0);
    StrCopy(DestDir,pchar(ADestDir));
  end;
  FillChar(FileOpStruct,SizeOf(FileOpStruct),0);
  with FileOpStruct do
  begin
    pFrom:=FromDir;
    if UpperCase(OP)='COPY' then
    begin
      wFunc:=FO_COPY;
      pTo:=DestDir;
      fFlags:=FOF_NOCONFIRMATION;
    end;
    if UpperCase(OP)='DELETE' then
    begin
      wFunc:=FO_DELETE;
      fFlags:=FOF_NOCONFIRMATION;
    end;
  end;
  try
    if SHFileOperation(FileOpStruct)=0 then Result:=True;
  finally
    FreeMem(FromDir,length(AFromDir)+2);
    if ADestDir<>'' then
      FreeMem(DestDir,length(ADestDir)+2);
  end;
end;还有move,rename等

Answer 5

function FileOperation(const AFromDir,ADestDir,Op:string):Boolean;
var
  FileOpStruct:TSHFileOpStruct;
  FromDir,DestDir:pchar;
begin
  Result:=False;
  GetMem(FromDir,length(AFromDir)+2);
  FillChar(FromDir^,length(AFromDir)+2,0);
  StrCopy(FromDir,pchar(AFromDir));
  if ADestDir<>'' then
  begin
    GetMem(DestDir,length(ADestDir)+2);
    FillChar(DestDir^,length(ADestDir)+2,0);
    StrCopy(DestDir,pchar(ADestDir));
  end;
  FillChar(FileOpStruct,SizeOf(FileOpStruct),0);
  with FileOpStruct do
  begin
    pFrom:=FromDir;
    if UpperCase(OP)='COPY' then
    begin
      wFunc:=FO_COPY;
      pTo:=DestDir;
      fFlags:=FOF_NOCONFIRMATION;
    end;
    if UpperCase(OP)='DELETE' then
    begin
      wFunc:=FO_DELETE;
      fFlags:=FOF_NOCONFIRMATION;
    end;
  end;
  try
    if SHFileOperation(FileOpStruct)=0 then Result:=True;
  finally
    FreeMem(FromDir,length(AFromDir)+2);
    if ADestDir<>'' then
      FreeMem(DestDir,length(ADestDir)+2);
  end;
end;