Delphi中拷贝文件夹的几个函数

时间:2022-07-10 21:36:15

 思路1:直接使用CopyFile,循环查找文件夹下文件,拷贝到指定目录,(这里测试,不含子目录)

procedure CopyDirectory(SourceDir, DesDir: string);
var
    DirInfo: TSearchRec;
    r: Integer;
begin
    r := FindFirst(SourceDir + '*.*', FaAnyFile, DirInfo);
    while r = 0 do
    begin
        if ((DirInfo.Attr and FaDirectory <> FaDirectory) and
            (DirInfo.Attr and FaVolumeId <> FaVolumeID)) then
            CopyFile(pchar(SourceDir + DirInfo.Name), pchar(DesDir + DirInfo.Name), True);
        r := FindNext(DirInfo);
    end;
    SysUtils.FindClose(DirInfo);
end;
如果想含有子目录,加一递归即可.
思路2:使用API,TSHFileOpStruct 结构.含有子目录.
procedure CopyFileByFolder(Ahandle: THandle; fromDir,
  toDir: String);
var
  SHFileOpStruct: TSHFileOpStruct;
  pFromDir, pToDir: PAnsiChar;
begin
  GetMem(pFromDir, Length(fromDir)+2);
  try
    GetMem(pToDir, Length(toDir)+2);
    try

      FillChar(pFromDir^, Length(fromDir)+2, 0);
      FillChar(pToDir^, Length(toDir)+2, 0);

      StrCopy(pFromDir, PChar(fromDir));
      StrCopy(pToDir, PChar(toDir));

      with SHFileOpStruct do
      begin
        Wnd    := AHandle;   // Assign the window handle
        wFunc  := FO_COPY;  // Specify a file copy
        pFrom  := pFromDir;
        pTo    := pToDir;
        fFlags := FOF_NOCONFIRMATION or FOF_SILENT;
        fAnyOperationsAborted := True;
        hNameMappings := nil;
        lpszProgressTitle := nil;
        if SHFileOperation(SHFileOpStruct) <> 0 then
          RaiseLastWin32Error;
      end;
    finally
      FreeMem(pToDir, Length(ToDir)+2);
    end;
  finally
    FreeMem(pFromDir, Length(FromDir)+2);
  end;
end;