Создание директории если количество файлов равно значению - Общие вопросы Delphi

artemavd · 25.11.2010, 12:17

Доброе утро! Может не очень понятно название темы, но сейчас попробую объяснить. У меня в папку добалвляются файлы. Я могу получить их количество в папке и занести в переменную типа TStringList так:

Код:

procedure TMainForm.Button1Click(Sender: TObject);
var
 SR,SR_DELETE: TSearchRec;
 FindRes, FindRes_DELETE:Integer;
 list,list_DELETE: TStringList;
 j,j_DELETE: integer;
begin
 MainForm.ListBox9.Clear;
 FindRes:=FindFirst(MainForm.Edit8.Text + '*.pdf',faAnyFile,SR);
 while FindRes = 0 do
 begin
  if (SR.Name <> '.') or (SR.Name <> '..') then
  begin
   MainForm.ListBox9.Items.Add(MainForm.Edit8.Text + SR.Name);
   FindRes:=FindNext(SR);
  end;
 end;
 FindClose(SR);
 MainForm.Button1.Caption:=IntToStr(ListBox9.Items.Count);
 CreateDir(MainForm.Edit8.Text + '\1');  //нужно как-то узнать путь к только что созданной папке???

 FullDirectoryCopy_PDF(MainForm.Edit8.Text,MainForm.Edit8.Text + '\1',False,True);

//Find and Delete PDF's from Listbox9
 MainForm.ListBox9.Clear;
 FindRes_DELETE:=FindFirst(MainForm.Edit8.Text + '\1' + '*.pdf',faAnyFile,SR_DELETE);
 while FindRes_DELETE = 0 do
 begin
  if (SR_DELETE.Name <> '.') or (SR_DELETE.Name <> '..') then
  begin
   MainForm.ListBox9.Items.Add(MainForm.Edit8.Text + '\1\' + SR_DELETE.Name);
   FindRes_DELETE:=FindNext(SR_DELETE);
  end;
 end;
 FindClose(SR_DELETE);
 list_DELETE:=TStringList.Create;
   for j_DELETE:=0 to MainForm.ListBox9.Count - 1 do
   begin
    list_DELETE.Clear;
    list_DELETE.Add(MainForm.ListBox9.Items[j_DELETE]);
    DeleteFile(MainForm.ListBox9.Items[j_DELETE]);
   end;
  list_DELETE.Free;
end;

Мне нужно, что если например переменная list = 10, то в директории, куда сохраняются файлы, создавалась бы папка с именем "1" и в нее копировались бы эти 10 файлов. Потом, когда переменная list снова равна 10 (10 - это число в качестве примера, может быть любое), то создавалась в директории уже другая папка "2" и в нее копировались бы уже новые эти 10 файлов. С копированием файлов я разберусь. Мне нужная помощь в этом:

Цитата:

если например переменная list = 10, то в директории, куда сохраняются файлы, создавалась бы папка с именем "1" и в нее копировались бы эти 10 файлов.

Помогите с этим пожалуйста..

-----
Восстановил тему. Начал делать на примере одной папки и запутался в логике работы кода

. Код выше я дополнил.

Serge_Bliznykov · 25.11.2010, 13:07

так, конспективно (просто в качестве примера):

Код:

MainForm.ListBox9.Clear;
 iFileCount := 0; 
 FindRes:=FindFirst(MainForm.Edit8.Text + '*.pdf',faAnyFile,SR);
 while FindRes = 0 do
 begin
  if (SR.Name <> '.') or (SR.Name <> '..') then
  begin
   MainForm.ListBox9.Items.Add(MainForm.Edit8.Text + SR.Name);
   inc(iFileCount);
   if iFileCount = 10 then begin
            Ваше действие;; например, ForceDirectories()
         iFileCount := 0; {счётчик сбросили}
   end;
   FindRes:=FindNext(SR);
  end;
 end;

Sibedir · 25.11.2010, 13:09

Проблема в копировании файлов или в создании папок с номерами по порядку?

artemavd · 25.11.2010, 13:25

Цитата:

в создании папок с номерами по порядку?

Да, с этим и копированием файлов именно туда. Т.к. это должно происходит без участия пользователя.

Sibedir · 25.11.2010, 13:37

Код:

function CreateNextDirectory (APath: String): String;
var
  i: Integer;
begin
  for i := 1 to 1000 do begin
    Result := APath + IntToStr(i) + '\';
    if not DirectoryExists(Result) then begin
      ForceDirectories (Result);
      Exit;
    end;
  end;
  Result := '';
end;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  NewPath: String;
begin
  NewPath := CreateNextDirectory (ExtractFilePath (Application.ExeName));
  // Далее копируем файлы в NewPath
end;

artemavd · 25.11.2010, 14:54

Благодаря коду Sibedir я разобрался как выстроить работу кода и сделал

. Вот код (может кому пригодится):

Код:

function CreateNextDirectory (APath: String): String;
var
  i: Integer;
begin
  for i := 1 to 1000 do begin
    Result := APath + IntToStr(i) + '\';
    if not DirectoryExists(Result) then
    begin
      ForceDirectories (Result);
      Exit;
    end;
  end;
  Result := '';
end;

procedure TMainForm.Button1Click(Sender: TObject);
var
 SR,SR_DELETE: TSearchRec;
 FindRes, FindRes_DELETE:Integer;
 list,list_DELETE: TStringList;
 j,j_DELETE,kol: integer;
 Path,s: string;
begin
 MainForm.ListBox9.Clear;
 FindRes:=FindFirst(MainForm.Edit8.Text + '*.pdf',faAnyFile,SR);
 while FindRes = 0 do
 begin
  if (SR.Name <> '.') or (SR.Name <> '..') then
  begin
   MainForm.ListBox9.Items.Add(MainForm.Edit8.Text + SR.Name);
   FindRes:=FindNext(SR);
  end;
 end;
 FindClose(SR);
 kol:=ListBox9.Items.Count;
 Path:=CreateNextDirectory(MainForm.Edit8.Text);
 s:=Path;

 FullDirectoryCopy_PDF(MainForm.Edit8.Text,s,False,True);

//Find and Delete PDF's from Listbox9
 MainForm.ListBox9.Clear;
 FindRes_DELETE:=FindFirst(MainForm.Edit8.Text + '*.pdf',faAnyFile,SR_DELETE);
 while FindRes_DELETE = 0 do
 begin
  if (SR_DELETE.Name <> '.') or (SR_DELETE.Name <> '..') then
  begin
   MainForm.ListBox9.Items.Add(MainForm.Edit8.Text + SR_DELETE.Name);
   FindRes_DELETE:=FindNext(SR_DELETE);
  end;
 end;
 FindClose(SR_DELETE);
 list_DELETE:=TStringList.Create;
   for j_DELETE:=0 to MainForm.ListBox9.Count - 1 do
   begin
    list_DELETE.Clear;
    list_DELETE.Add(MainForm.ListBox9.Items[j_DELETE]);
    DeleteFile(MainForm.ListBox9.Items[j_DELETE]);
   end;
  list_DELETE.Free;
end;

Теперь нужно куда-то в код поставить условие про количество файлов. Serge_Bliznykov, подскажите пожалуйста куда в коде разместить это условие? Чтобы если достигло количества файлов, то срабатывал бы этой код мой, а если нет, то не срабатывал бы.

wm_leviathan · 25.11.2010, 15:16

Код:

function CreateNextDirectory (APath: String): String;
var
  i: Integer;
begin
  for i := 1 to 1000 do begin
    Result := APath + IntToStr(i) + '\';
    if not DirectoryExists(Result) then
    begin
      ForceDirectories (Result);
      Exit;
    end;
  end;
  Result := '';
end;

procedure TMainForm.Button1Click(Sender: TObject);
var
 SR,SR_DELETE: TSearchRec;
 FindRes, FindRes_DELETE:Integer;
 list,list_DELETE: TStringList;
 j,j_DELETE,kol: integer;
 Path,s: string;
begin
 MainForm.ListBox9.Clear;
 FindRes:=FindFirst(MainForm.Edit8.Text + '*.pdf',faAnyFile,SR);
 while FindRes = 0 do
 begin
  if (SR.Name <> '.') or (SR.Name <> '..') then
  begin
   MainForm.ListBox9.Items.Add(MainForm.Edit8.Text + SR.Name);
   kol:=ListBox9.Items.Count; //узнаем количество итемов
   if kol=10 then begin  //если 10 то пора копирвать и удалять и еще всяко много
   CreateNextDirectory(MainForm.Edit8.Text); //создаем папку для файликов
   Path:=CreateNextDirectory(MainForm.Edit8.Text);
   s:=Path;
   FullDirectoryCopy_PDF(MainForm.Edit8.Text,s,False,True);// теперь копируем  в нее наши 10 файлов
   //пора удалять мусор за собой

   //Find and Delete PDF's from Listbox9
 MainForm.ListBox9.Clear;
 FindRes_DELETE:=FindFirst(MainForm.Edit8.Text + '*.pdf',faAnyFile,SR_DELETE);
 while FindRes_DELETE = 0 do
 begin
  if (SR_DELETE.Name <> '.') or (SR_DELETE.Name <> '..') then
  begin
   MainForm.ListBox9.Items.Add(MainForm.Edit8.Text + SR_DELETE.Name);
   FindRes_DELETE:=FindNext(SR_DELETE);
  end;
 end;
 FindClose(SR_DELETE);
 list_DELETE:=TStringList.Create;
   for j_DELETE:=0 to MainForm.ListBox9.Count - 1 do
   begin
    list_DELETE.Clear;
    list_DELETE.Add(MainForm.ListBox9.Items[j_DELETE]);
    DeleteFile(MainForm.ListBox9.Items[j_DELETE]);
   end;
  list_DELETE.Free;

   end;

   FindRes:=FindNext(SR);
  end;
 end;
 FindClose(SR);


end;

Sibedir · 25.11.2010, 15:27

Может так?

Код:

  MainForm.ListBox9.Clear;
  FindRes:=FindFirst(MainForm.Edit8.Text + '*.pdf',faAnyFile,SR);
  while FindRes = 0 do begin
    if (SR.Name <> '.') and (SR.Name <> '..') then begin
      MainForm.ListBox9.Items.Add(MainForm.Edit8.Text + SR.Name);

      if MainForm.ListBox9.Items.Count = 10 then begin
        Path:=CreateNextDirectory(MainForm.Edit8.Text);
        for i := 0 to 9 do begin
          s := MainForm.ListBox9.Items[i];
          MoveFile (s, Path + ExtractFileName(s));
        end;
        MainForm.ListBox9.Clear;
      end;

      FindRes:=FindNext(SR);
    end;
  end;
  FindClose(SR);

wm_leviathan · 25.11.2010, 15:33

признаю Move получше будет

artemavd · 25.11.2010, 15:38

Проверил код. Если количество файлов меньше заданного значения, то код не срабатывает, так и надо. А если количество файлов совпадает со значение, то создается две папки: "1" и "2" причем мои файлы кидаются в папку "2", а не в "1"...
Это я про код из поста №7

Кому не трудно, большая просьба, если подсказываете код, то вставляйте в основной в весь код, а то тяжело очень разбираться с этим кусками...есть же код полностью, почему бы туда не вставить свой вариант. Еще больше запутываешься от этих кусков кода...

25.11.2010, 15:38	#10
artemavd Старожил Регистрация: 05.06.2008 Сообщений: 4,206	Проверил код. Если количество файлов меньше заданного значения, то код не срабатывает, так и надо. А если количество файлов совпадает со значение, то создается две папки: "1" и "2" причем мои файлы кидаются в папку "2", а не в "1"... Это я про код из поста №7 Кому не трудно, большая просьба, если подсказываете код, то вставляйте в основной в весь код, а то тяжело очень разбираться с этим кусками...есть же код полностью, почему бы туда не вставить свой вариант. Еще больше запутываешься от этих кусков кода... Не стоит смеяться над человеком делающим шаг назад, возможно он делает разбег. Последний раз редактировалось artemavd; 25.11.2010 в 16:04.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Как записать условие меньше или равно функции ЕСЛИ()	Tidus	Microsoft Office Excel	9	18.02.2010 11:05
список файлов в web директории	Serega_P	Общие вопросы Delphi	3	11.06.2009 11:15
Программа получения списка файлов директории и изменения атрибутов файлов	roma86	Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM	7	09.06.2009 09:08
Программа просмотра файлов в директории	asale	Microsoft Office Excel	4	06.01.2009 13:53
Сравнение значений в ячейках и вывод соообщения если не равно.	Siver	Microsoft Office Excel	2	18.12.2008 04:42

25.11.2010, 13:09	#3
Sibedir Тот ещё Старожил Регистрация: 14.11.2007 Сообщений: 2,242	Проблема в копировании файлов или в создании папок с номерами по порядку?

25.11.2010, 15:33	#9
wm_leviathan Форумчанин Регистрация: 17.02.2010 Сообщений: 399	признаю Move получше будет