Все тот же ListBox

[Eugene_Stoun]

Ребята, прошу прощения если такая тема уже была.
Но вопрос в следующем: есть ListBox в нем результаты поиска файлов по папке вместе с подпапками, мне надо сделать перемещние всех файлов из ListBox в папку. Только в списке получается к примеру 89 файлов, а перемещает только 77, так как есть файлы с одинаковым именем, но в разных подпапках , как сделать так чтобы перемещались все 89 файлов?

Вот код для перемещения:

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
begin
  CreateDir('C:\Служебная');
  begin
    for i := 0 to ListBox1.Items.Count - 1 do
    begin
      if FileExists(ListBox1.Items.Strings[i]) then
      begin
        CopyFile(PChar(ListBox1.Items.Strings[i]), PChar('C:\Служебная' + ExtractFileName(ListBox1.Items.Strings[i])), False);
        DeleteFile(ListBox1.Items.Strings[i]);
      end;
    end;
  end;
end;

[Аватар]

function NewFileName(FileName: String): String;
var n: Integer;
begin
  Result:=FileName;
  n:=0;
  while True do begin
    if not FileExists(Result) then Exit;
    Inc(n);
    Result:=Format('%s (%d)',[FileName,n]);
  end;
end;

и вместо
CopyFile(PChar(ListBox1.Items.Strin gs[i]), PChar('C:\Служебная' + ExtractFileName(ListBox1.Items.Stri ngs[i])), False);

вставить
CopyFile(PChar(ListBox1.Items.Strings[i]),PChar(NewFileName('C:\Служебная\'+ExtractFileName(ListBox1.Items.Strings[i]))), False);

[Eugene_Stoun]

Все отлично, только нумерацию в скобках, ставит после расширения файла

[Аватар]

Да, прозевал. Выделите расширение, нумерацию после имени файла без расширения, а потом расширение. Так примерно

function NewFileName(FileName: String): String;
var n: Integer;
    s1,s2: String;
begin
  s2:=ExtractFileExt(FileName);
  if s2<>'' then s1:=Copy(FileName,1,Length(FileName)-Length(s2))
            else s1:=FileName;
  Result:=FileName;
  n:=0;
  while FileExists(Result) do begin
    Inc(n);
    Result:=Format('%s (%d)%s',[s1,n,s2]);
  end;
end;

[Eugene_Stoun]

Огромное спасибо за помощь