Копирование файлов из нескольких директорий в одну

[mihali4]

Может, это подойдет ?

{Копирование содержимого директории, вместе с поддиректориями.

Фукция копирует СОДЕРЖИМОЕ директории SourceDir в директорию TargetDir.
Копируются все файлы, подкаталоги, и файлы находящиеся в этих подкаталогах.

Аргумент StopIfNotAllCopied: если значение этого аргумента = True,
то при первой же ошибке копирования файла или папки, работы функции
прекратится а функуция вернёт False. В случае если этот аргумент = False,
то ошибки копирования учитываться не будут.

Аргумент OverWriteFiles: если True, то существующие файлы будут переписаны.

Зависимости: SysUtils, FileCtrl, Windows
Автор:       VID, snap@iwt.ru}

function FullDirectoryCopy(SourceDir, TargetDir: string; StopIfNotAllCopied,
  OverWriteFiles: Boolean): Boolean;
var
  SR: TSearchRec;
  I: Integer;
begin
  Result := False;
  SourceDir := IncludeTrailingBackslash(SourceDir);
  TargetDir := IncludeTrailingBackslash(TargetDir);
  if not DirectoryExists(SourceDir) then
    Exit;
  if not ForceDirectories(TargetDir) then
    Exit;
  I := FindFirst(SourceDir + '*', faAnyFile, SR);
  try
    while I = 0 do
    begin
      if (SR.Name <> '') and (SR.Name <> '.') and (SR.Name <> '..') then
      begin
        if SR.Attr = faDirectory then
          Result := FullDirectoryCopy(SourceDir + SR.Name, TargetDir + SR.NAME,
            StopIfNotAllCopied, OverWriteFiles)
        else if not (not OverWriteFiles and FileExists(TargetDir + SR.Name))
          then
          Result := CopyFile(Pchar(SourceDir + SR.Name), Pchar(TargetDir +
            SR.Name), False)
        else
          Result := True;
        if not Result and StopIfNotAllCopied then
          exit;
      end;
      I := FindNext(SR);
    end;
  finally
    SysUtils.FindClose(SR);
  end;
end;

Пример использования: 
FullDirectoryCopy('C:\Users\Admin\Desktop\Папка_1','C:\Users\Admin\Desktop\Папка_2',False,True);

[wm_leviathan]

Сообщение от artemavd

Добрый вечер! Нужна ваша помощь в решении вопроса. Ситуация: Есть 4 директории 1,2,3 и 4 и есть две папки: 1-1 и 1-2. Задача: нужно содержимое директории 1 скопировать в директорию 1-1, а содержимое директорий 2,3 и 4, одновременно, скопировать в директорию 1-2. С помощью чего и как такое можно сделать в таймере? Заранее спасибо.

на счет одновременно вряд ли выйдет т.к. программа начнет сначало копировать содержимое папки 2 потом содержимое папки 3 и потом содержимое папки 4. как вы понимаете это ни есть одновременно.
если именно одновременно надо то наверное для копирования содержимого папки 2 должен быть 1 поток. для папки 3 - 2й поток и для папки 4 - 3й поток, тогда получится более менее одновременное копирование.

[mihali4]

Копирование с показом стандартного окна копирования файлов:

var
Fo : TSHFileOpStruct;
buffer : array[0..4096] of char;
p : pchar;
begin
FillChar(Buffer, sizeof(Buffer), #0);
p := @buffer;
p := StrECopy(p, 'C:\DownLoad\1.ZIP') + 1;
p := StrECopy(p, 'C:\DownLoad\2.ZIP') + 1;
p := StrECopy(p, 'C:\DownLoad\3.ZIP') + 1;
StrECopy(p, 'C:\DownLoad\4.ZIP');
FillChar(Fo, sizeof(Fo), #0);
Fo.Wnd := Handle;
Fo.wFunc := FO_COPY;
Fo.pFrom := @Buffer;
Fo.pTo := 'D:\';
Fo.fFlags := 0;
if ((SHFileOperation(Fo) <> 0) or (Fo.fAnyOperationsAborted <> false)) then
ShowMessage('Cancelled')
end;

И еще:

Как получить список файлов со всеми подкаталогами

procedure ScanDir(StartDir: string; Mask:string; List:TStrings);
var
SearchRec : TSearchRec;
begin
if Mask = '' then Mask := '*.*';
if StartDir[Length(StartDir)] <> '\' then StartDir := StartDir + '\';
if FindFirst(StartDir+Mask, faAnyFile, SearchRec) = 0 then
begin
repeat
Application.ProcessMessages;
if (SearchRec.Attr and faDirectory) <> faDirectory then
List.Add(StartDir + SearchRec.Name)
else if (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then
begin
List.Add(StartDir + SearchRec.Name + '\');
ScanDir(StartDir + SearchRec.Name + '\',Mask,List);
end;
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
end;

Пример вызова. параметры
1. имя папки
2. маска, по умолчанию *.*
3. хранилище для результата, любой наследник от TString, например TStringList

procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Items.Clear;
ScanDir('c:','',ListBox1.Items);
Label1.Caption := IntToStr(ListBox1.Items.Count);
end;

И еще:

Копирование методом потока

Procedure FileCopy(Const SourceFileName, TargetFileName: String);
Var
S,T   : TFileStream;
Begin
S := TFileStream.Create(sourcefilename, fmOpenRead );
try
T := TFileStream.Create(targetfilename, fmOpenWrite or fmCreate);
try
T.CopyFrom(S, S.Size ) ;
FileSetDate(T.Handle, FileGetDate(S.Handle));
finally
T.Free;
end;
finally
S.Free;
end;
end;

[psycho-coder]

А если в папке много подпапок, то рекурсия вывалится в переполнение буфера?

[maxionans]

А если в папке много подпапок, то рекурсия вывалится в переполнение буфера?

может, но это маловероятно: нужно ооочень много подпапок

[psycho-coder]

Сообщение от maxionans

может, но это маловероятно: нужно ооочень много подпапок

например папка Windows?

[artemavd]

Итак, всем большое спасибо за ответы в этой теме, я собрал в кучу то, что вы мне предлагали и получил следующую картину, работает так как и задумывалось, но только надо кое какие нюансы еще доделать. Итак, картинка получается такая.
В MainForm.Edit9.Text - указывается путь откуда берутся JPEG файлы.
В MainForm.Edit13.Text - указывается путь, куда копируются эти JPEG.
Иными словами папку по пути MainForm.Edit9.Text можно считать как бы времененной, но, не в ней дело. Далее.
В MainForm.Edit13.Text у меня также через таймер создаются PDF файлы, которые получаются путем перевода из JPEG в PDF, одновременно с этим в ListBox5 содержится список этих JPEG файлов, которые находятся в папке по пути MainForm.Edit13.Text. Вот. Так вот, как только эти JPEG файлы переведены в PDF, то в папке MainForm.Edit13.Text они больше не нужны и их нужно удалить оттуда совсем, чтобы там остались только PDF-ки. Так вот, вот код,

procedure TMainForm.Timer1Timer(Sender: TObject);
var
 SR_1: TSearchRec;
 FindRes_1,i:Integer;
begin
 FullDirectoryCopy(MainForm.Edit9.Text,MainForm.Edit13.Text,False,True);

 MainForm.ListBox5.Clear;
 FindRes_1:=FindFirst(MainForm.Edit13.Text + '*.jpeg',faAnyFile,SR_1);
 while FindRes_1 = 0 do
 begin
  if (SR_1.Name <> '.') or (SR_1.Name <> '..') then
  begin
   MainForm.ListBox5.Items.Add(MainForm.Edit13.Text + SR_1.Name);
   FindRes_1:=FindNext(SR_1);
  end;
 end;
 FindClose(SR_1);
end;

которая ищет JPEG файлы и копирует их из MainForm.Edit9.Text в MainForm.Edit13.Text с заменой имеющихся, а также добавляет с полными путями их в Listbox5.
Вот код, который также в таймере переводи JPEG файлы в PDF:

procedure TMainForm.Timer2Timer(Sender: TObject);
var
 k,i: integer;
 list: TStringList;
begin
 list:=TStringList.Create;
   for i:=0 to MainForm.ListBox5.Count - 1 do
   begin
    list.Clear;
    list.Add(MainForm.ListBox5.Items[i]);
    k:=ListeJPGtoPDF(list,MainForm.Edit13.Text + Copy(ExtractFileName(MainForm.ListBox5.Items[i]),1,Pos('.',ExtractFileName(MainForm.ListBox5.Items[i]))-1) + '.pdf');
    SaveFolderTree_Dilers(MainForm.Edit13.Text, MainForm.Edit13.Text + 'A5.xml');
//    MainForm.ListBox5.Clear;
   end;
  list.Free;
end;

Что мне нужно-то...
1. Чтобы из ListBox5 удалялись файлы, а Timer2 при этом останавливался если список пуст, а включался только тогда когда ListBox5 непустой и т.д.
2. Куда поместить строчку Application.ProcessMessages?
3. Какое значение выставить в свойстве Interval у таймеров, чтобы нормально все работало и не притормаживало?
Помогите мне пожалуйста с этими маленькими вопросами...

[wm_leviathan]

с копированием и переводом понятно. но зачем нужны таймеры? да еще и 2.
если сделать например так. из пути "Edit9.Text" файл(ы) скопировался(сь) в папку "Edit13.Text". далее заполняем LIstBox. как только заполнили LIstBox стартовала функция перевода этих картинок в PDF. далее как только перевела в PDF, открываем папку с картинками и удаляем все JPEG. потом очищаем листБокс. вроде процесс такой если я правильно все понял.

[artemavd]

из пути "Edit9.Text" файл(ы) скопировался(сь) в папку "Edit13.Text". далее заполняем LIstBox. как только заполнили LIstBox

так, хорошо, это я сделал так:

procedure TForm1.BtnExecuteClick(Sender: TObject);
var
 SR_1: TSearchRec;
 FindRes_1,k,i:Integer;
 list: TStringList;
begin
 FullDirectoryCopy(Form1.Edit1.Text,Form1.Edit4.Text,False,True);

 Form1.ListBox1.Clear;
 FindRes_1:=FindFirst(Form1.Edit1.Text + '*.jpeg',faAnyFile,SR_1);
 while FindRes_1 = 0 do
 begin
  if (SR_1.Name <> '.') or (SR_1.Name <> '..') then
  begin
   Form1.ListBox1.Items.Add(Form1.Edit1.Text + SR_1.Name);
   FindRes_1:=FindNext(SR_1);
  end;
 end;
 FindClose(SR_1);

//JPEG to PDF
 list:=TStringList.Create;
   for i:=0 to Form1.ListBox1.Count - 1 do
   begin
    list.Clear;
    list.Add(Form1.ListBox1.Items[i]);
    k:=ListeJPGtoPDF(list,Form1.Edit4.Text + Copy(ExtractFileName(Form1.ListBox1.Items[i]),1,Pos('.',ExtractFileName(Form1.ListBox1.Items[i]))-1) + '.pdf');
    SaveFolderTree_Dilers(Form1.Edit4.Text, Form1.Edit4.Text + 'export.xml')
   end;
  list.Free;
end;

теперь

открываем папку с картинками и удаляем все JPEG

как написать, чтобы удалились именно те файлы, полные пути к которым указаны в Listbox-e?

[wm_leviathan]

цикл по всем итемам листБокса и

DeleteFile(ListBox1.Item[i]);

и тут же очищай сам лист бокс
ЗЫ

procedure TForm1.BtnExecuteClick(Sender: TObject);
var
SR_1: TSearchRec;
FindRes_1,k,i:Integer;
list: TStringList;
begin
FullDirectoryCopy(Form1.Edit1.Text, Form1.Edit4.Text,False,True);

Form1.ListBox1.Clear;
FindRes_1:=FindFirst(Form1.Edit1.Te xt + '*.jpeg',faAnyFile,SR_1);
while FindRes_1 = 0 do
begin
if (SR_1.Name <> '.') or (SR_1.Name <> '..') then
begin
Form1.ListBox1.Items.Add(Form1.Edit 1.Text + SR_1.Name);
FindRes_1:=FindNext(SR_1);
end;
end;
FindClose(SR_1);

1й раз копируешь файлы FullDirectoryCopy(Form1.Edit1.Text, Form1.Edit4.Text,False,True);
и сразу в этой фукции добавляй Form1.ListBox1.Items.Add(); зачем 2 раза сканировать папку?