treeview, содержимое папки Опции

[volvo]

Стоп. Ну, удалил ты с диска папку вместе со всем ее содержимым (с диска-то она удаляется, надеюсь, к коду из DRKB претензий нет?). А как ты обновляешь содержимое TreeView? Или это у тебя MyRemoveDir так коверкает папки? (проверить не могу, Дельфи не установил еще)

[Client]

Ок, стоп
Дело как раз в том, что с диска не удаляется. (Почему-то сразу не сказал об этом )
Обновляю новым поиском файлов. Тут все нормально
Путь

Код

D:\my folder - копия

Папка в архиве (она только для теста, делал сам )

Добавлено через 9 мин.
Сори, не тот архив (этот уже обработан программой)
Вот что надо

[volvo]

Ты будешь смеяться, но...
До удаления:


После удаления:


Только я не перезапускаю поиск файлов заново. Я делаю так:

procedure TForm1.deleteobject1Click(Sender: TObject);
var myPath: string;
begin
  myPath := ExcludeTrailingPathDelimiter(SrNodeTree(TreeView1.Selected));
  if DirectoryExists(myPath) then MyRemoveDir(myPath); // С файлами - надо будет просто удалить файл

  TreeView1.Selected.DeleteChildren; // Это вместо пересканирования: удаляем потомков
  TreeView1.Selected.Delete;  // и сам узел
end;

Так что все работает...

[Client]

чудеса значит.
если просто удалить пустую - то все норм.
причем в выбранной папке и во всех подпапках нету ни 1 файла

Сообщение отредактировано: Client - 12.04.2010 22:51

[volvo]

Кстати, на форуме forums.embarcadero.com великий и могучий ( ) Remy Lebeau чуть-чуть поправил функцию MyRemoveDir:

function MyRemoveDir(sDir: string): Boolean;
var
  SearchRec: TSearchRec;
begin
  sDir := IncludeTrailingPathDelimiter(sDir);
  if FindFirst(sDir + '*.*', faAnyFile, SearchRec) = 0 then
  try
    repeat
      if (SearchRec.Attr and faDirectory) <> 0 then
      begin
        if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
          MyRemoveDir(sDir + SearchRec.Name);
      end;
    until FindNext(SearchRec) <> 0;
  finally
    FindClose(SearchRec);
  end;
  Result := RemoveDir(sDir);
end;

Попробуй может это у тебя сработает (если все подпапки пустые)... В любом случае, как только установлю все ПО на Win7 - погоняю этот код там тоже...

[Client]

Проверенным методом трассировки выяснилось, что удаляются папки последнего уровня, в которых нет подкаталогов. Т.е. самый последний уровень удаляется и в системе он становится заблоченым, пока прогу не закроешь. Файлы удаляются свободно и в самой папке тоже обновляется, т.е. файл и для винды удаяется. Потом при попытке удалить надкаталог, функция возвращает результат false, т.е. надкаталок для последней папки уже не может удалиться, т.к. в нем все еще сидит "как бы уже удаленная" папка.
Воть
Воткнуть бы какую - нибудь процедрку для обновления папки...

Попробуй может это у тебя сработает (если все подпапки пустые)...

Эффект точно такой же - удаляются только посление папки.
Видимо все дело в висте

[volvo]

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

Хм... "Меня терзают смутные сомнения" (С). А у тебя, мил человек, эта папка, которая залочивается, случайно не текущая в твоем приложении? Тогда все так: пока приложение не закроешь - эту папку не удалишь с диска. Проверь это. И также проверь, какую ошибку возвращает GetLastError сразу после того, как RemoveDir вернула False (хотя подозреваю, что вернется 18: ERROR_NO_MORE_FILES, как результат того, что FindNext завершил обработку папки). Короче, проверяй, какая директория - текущая в приложении, или кто еще держит эту директорию, которая "как бы удаляется". Не помню, чтобы где-то всплывал разговор о подобном поведении Висты. Так что ошибка где-то в другом месте.

[Client]

Да, папку нельзя удалить.
Выдает ошибку 18 и 145.
Хм, а как это исправить?

[volvo]

папка, которая залочивается, случайно не текущая в твоем приложении?

Это я что, просто так спросил? Перед попыткой вызова RemoveDir смотри, что за папка В ДАННЫЙ МОМЕНТ является текущей. Если она совпадает (или является ПОДпапкой) той, что ты хочешь удалять - то можешь даже и не пытаться. Перебрасывай текущую папку куда-нибудь в другое место, и тогда пробуй удалять.

Это все приколы Висты. (Показать/Скрыть)

Ибо Win7 - полет нормальный, обе версии MyRemoveDir отработали на любой из подпапок без малейшего сопротивления... Также, как и на WinXP.

[Client]

Скорей всего это не из-за висты.
Вся работа с папкой - это заненесение в бд. т.е. связь с папкой остается в переменной типа TSearchRec если его не закрыть?
У меня код для этого, анологичен коду из 2 поста этой темы.
Именно после выполнения этого кода, папку нельзя удалить, пока не закрою прогу.
Буду править код.

что за папка В ДАННЫЙ МОМЕНТ является текущей

хм, если бы я знал...

Перебрасывай текущую папку куда-нибудь в другое место

А это как? сделать поиск в другом каталоге?

Сообщение отредактировано: Client - 13.04.2010 2:11

[volvo]

если бы я знал

GetCurrentDirectory никто не отменял.

А это как?

SetCurrentDirectory тоже.

[Client]

Все исправил, ошибка была при поиске файлов, видимо не все TSearchRec были закрыты.
Теперь файлы и папки удаляются
А GetCurrentDirectory постоянно указывает на каталог

Код

C:\Users\Alex\Documents\RAD Studio\Projects

но это не важно.
Спасибо volvo за помощь, в который раз уже выручаешь

[Client]

понадобилось вывести все элементы выбранной ветки.

procedure fillmemo (node : TTreeNode; st : string);
var
  myNode : TTreeNode;
  s : string;
begin
  myNode :=node;
  s := myNode.Text;
  while myNode <> nil do
  begin
    if myNode.HasChildren then begin
      s := myNode.Text;
      ArchiveForm.Memo1.Lines.Add(st + s);
      fillmemo(myNode.getFirstChild, st + '   ');
    end
    else begin
      s := myNode.Text;
      ArchiveForm.Memo1.Lines.Add(st + s);
    end;
    myNode := myNode.getNextSibling;
  end;
end;

procedure TArchiveForm.Button3Click(Sender: TObject);
begin
  Memo1.Clear;
  fillmemo(TreeView1.Selected, '');
end;

выводит элементы до конца (самого последнего) от выбранного пункта.

[volvo]

Не совсем... Что именно требуется, расскажи?

[Client]

УРААА
сделал так, почти твой код )

procedure fillmemo (node : TTreeNode; st : string);
var
  myNode : TTreeNode;
  s, s1 : string;
begin
  s := node.Text;
  ArchiveForm.Memo1.Lines.Add(st + s);
  myNode := node.getFirstChild;
  while mynode <> nil do
  begin
    s := myNode.Text;
    if myNode.HasChildren then
      fillmemo(myNode, st + '  ')
    else
      ArchiveForm.Memo1.Lines.Add(st + s);
    myNode := myNode.getNextSibling;
  end;
end;

Обожаю рекурсию

Не совсем... Что именно требуется, расскажи?

В моем варианте выделялись все элементы после выбранного, а надо было только его потомков.

[volvo]

Зачем лишние действия делать?

procedure FillMemo(node: TTreeNode; st : string);
var
  myNode : TTreeNode;
  s: string;
begin
  s := node.Text;
  ArchiveForm.Memo1.Lines.Add(st + s);

  myNode := node.getFirstChild;
  while mynode <> nil do
  begin
    FillMemo(myNode, st + '  ');
    myNode := myNode.getNextSibling;
  end;
end;

тоже выделяет только потомков, но не соседей...