Lazarus & Free Pascal - How to recursively copy a source directory of files to another directory?

问题

I need to add some functionality to my Lazarus & Free Pascal GUI program - I need it to also copy files from a users chosen dir to another dir. I have a "Choose Source" TSelectDirectoryDialog button onclick event for the source directory and a "Choose Destination" TSelectDirectoryDialog button onclick event for the destination dir. I have a 3rd button to do the copying from Source to Destination.

So far, I have found CopyFile that copies the files and the original date attributes, but it doesn't recreate the subdirectory structure of any subdirectories of the users chosen source directory. I am, in effect, trying to replicate the source directory in a new directory elsewhere.

I have got this far :

Public Vars :
DestDir, SourceDir : string
...
FS := TFileSearcher.Create;
FS.OnFileFound := @CopyTheFile;  // CopyTheFile is my own procedure 
FS.Search(SourceDir, '*', True);   
...

procedure TForm1.CopyTheFile(FileIterator: TFileIterator);
var
  DestinationName: String;
begin
  DestinationName := IncludeTrailingPathDelimiter(DestDir) + ExtractFileName(FileIterator.FileName);
  if not FileUtil.CopyFile(FileIterator.FileName, DestinationName, true) then
    ShowMessage(FileIterator.FileName + ' failed to copy');
end;        

Can anyone help me with how to code in copying of subdirectories and their files? I have also asked the question at the Lazarus forum here : Lazarus Thread

Many thanks

Ted

回答1:

I am VERY HAPPY AND PROUD and to provide, for the first time, an answer to my own question! I stripped the whole thing back to basics and stopped reading other people's more complex examples (because they just confused me). I stuck to the basic procedures listed at Lazarus FileUtils Ref and came up with this, which works. I need to build in some error checking and stuff, but what I now have is code that takes the source directory, rebuilds it in the destination directory and then copies the files from the originating directory to the destination, using entirely Free Pascal code and no OS specific syntax. Pasted below for benefit of others. Please add any contructive comments to make it better, faster, more efficient. Thanks.

procedure TForm1.Button3Click(Sender: TObject);
begin
  ProcessDir(SourceDir);
end;

procedure TForm1.ProcessDir(const SourceDirName: string);

var
  NoOfFilesFoundInSourceDir, i, NoOfFilesCopiedOK : integer;
  FilesFoundToCopy : TStringList;
  SourceDirectoryAndFileName, SubDirStructure, FinalisedDestDir, FinalisedFileName : string;

begin
  Memo1.Lines.Clear;
  SubDirStructure := '';
  FinalisedDestDir := '';
  NoOfFilesFoundInSourceDir := 0;
  NoOfFilesCopiedOK := 0;

  // Ensures the selected source directory is set as the directory to be searched
  // and then fina all the files and directories within, storing as a StringList.

  SetCurrentDir(SourceDirName);
  FilesFoundToCopy := FindAllFiles(SourceDirName, '*', True);
  NoOfFilesFoundInSourceDir := FilesFoundToCopy.Count;

  try
    for i := 0 to FilesFoundToCopy.Count -1 do
      begin
        Memo1.Lines.Add('File Index : '+IntToStr(i)+' File Name: '+FilesFoundToCopy.Strings[i]);
        SourceDirectoryAndFileName := ChompPathDelim(CleanAndExpandDirectory(FilesFoundToCopy.Strings[i]));

    // Determine the source sub-dir structure, from selected dir downwards

    SubDirStructure := IncludeTrailingPathDelimiter(ExtractFileDir(SourceDirectoryAndFileName));

    // Now concatenate the original sub directory to the destination directory and form the total path, inc filename
    // Note : Only directories containing files will be recreated in destination. Empty dirs are skipped.
    // Zero byte files are copied, though, even if the directory contains just one zero byte file.

    FinalisedDestDir := DestDir+SubDirStructure;
    FinalisedFileName := ExtractFileName(FilesFoundToCopy.Strings[i]);

    // Now create the destination directory structure, if it is not yet created. If it exists, just copy the file.

    if not DirPathExists(FinalisedDestDir) then
      begin
        if not ForceDirectories(FinalisedDestDir) then
          begin
            ShowMessage(FinalisedDestDir+' cannot be created.');
          end;
      end;

    // Now copy the files to the destination dir

    if not FileUtil.CopyFile(SourceDirectoryAndFileName, FinalisedDestDir+FinalisedFileName, true) then
      begin
        ShowMessage('Failed to copy file : ' + SourceDirectoryAndFileName)
      end
    else
    NoOfFilesCopiedOK := NoOfFilesCopiedOK + 1;
  end;
  finally
    FilesFoundToCopy.free;
  end;
  ShowMessage('Total files copied OK : ' + IntToStr(NoOfFilesCopiedOK));
end;       

来源：https://stackoverflow.com/questions/9278513/lazarus-free-pascal-how-to-recursively-copy-a-source-directory-of-files-to-a