Скачать: CL | DM;

Не удаляется каталог функцией SHFileOperation.   Найти похожие ветки 

← →
V.exeR   (2005-08-08 16:23) [0]

Ситуация такая: не удается удалить каталог функцией SHFileOperation. Пишет, что каталог используется какой-то программой. Удалять именно через SHFileOperation критично. Каталог абсолютно "левый" - не системный, не с программами, просто тестовый каталог. Единственный ньюанс - я перед этим рекурсивно просматриваю дерево каталогов, в который входит этот "неудаляемый" каталог. Но все FindFirstFile закрыты соответствующими FindClose, а других сложностей не вижу. Код привести сложно, но если приспичит - вырежу, опубликую. Кто-нибудь сталкивался с подобными трудностями? И если кто-нибудь сталкивался, как решали?

P.S. (Не)кстати - общий поиск по сайту не работает, причем довольно давно...

---

← →
Ботвин Дмитрий   (2005-08-08 17:03) [1]

Приводи код...

---

← →
Fay ©   (2005-08-08 17:05) [2]

2 V.exeR   (08.08.05 16:23)
Что возвращает SHFileOperation?

---

← →
V.exeR   (2005-08-09 07:52) [3]

2 Fav: Возвращает код 32.
Привожу код...
tvLibrary - TTreeView, в нем строится копия дерева каталогов.


Procedure TMainForm.bDelDateClick(Sender: TObject);
Var Temp: String;
   SHFileOpStruct : TSHFileOpStruct;
Begin
 Temp:=ExcludeTrailingBackslash(ExtractFilePath(GetPath(tvLibrary.Selected)));
 If MessageDlg("Вы действительно хотите удалить подкаталог "+tvLibrary.Selected.Text+"?",mtWarning,[mbYes,mbNo],0)=mrYes Then
   Begin
     ChDir(AppDir);
     With SHFileOpStruct Do
     begin
       Wnd:=Handle;
       wFunc:=FO_DELETE;
       pFrom:=PChar(Temp);
       pTo:=nil;
       fFlags:=FOF_ALLOWUNDO;
       fAnyOperationsAborted:=False;
       hNameMappings:=nil;
       lpszProgressTitle:=nil;
     end;
     IntToStr(SHFileOperation(SHFileOpStruct));
     tvLibrary.Items.Clear;
     BuildTree(OpenDialog.InitialDir+"\DataBase\",nil);
   End;
End;


И BuildTree...


Procedure TMainForm.BuildTree(Path: String; Node: TTreeNode);
Var Found: Integer;
   SR: TWin32FindDataA;
   kk: Cardinal;
   FileName, Temp: String;
   NNode: TTreeNode;
Begin
 Found:=Windows.FindFirstFile(PChar(Path+"*.*"),SR);
 While Found>0 Do
 With SR Do
 Begin
   kk:=0;
   FileName:="";
   While cFileName[kk]>#0 Do
   Begin
     FileName:=FileName+cFileName[kk];
     Inc(kk);
   End;
   If (dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY=0) and ((UpperCase(ExtractFileExt(Filename))=".DAT") or (UpperCase(ExtractFileExt(Filename))=".TXT")) Then
   Begin
     Temp:=ExtractFileName(FileName);
     NNode:=tvLibrary.Items.AddChild(Node,Temp);
     NNode.SelectedIndex:=9;
     NNode.ImageIndex:=9;
     NNode.StateIndex:=9;
   End Else
   If (dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY>0) Then
   Begin
     If cFileName[0]<>"." Then
     Begin
       NNode:=Node;
       Node:=tvLibrary.Items.AddChild(NNode,FileName);
       If Node.Level=0 Then
       Begin
         Node.SelectedIndex:=7;
         Node.ImageIndex:=7;
         Node.StateIndex:=7;
       End Else
       Begin
         Node.SelectedIndex:=8;
         Node.ImageIndex:=8;
         Node.StateIndex:=8;
       End;
       BuildTree(Path+FileName+"\",Node);
       Node:=NNode;
     End;
   End;
   if not FindNextFile(Found,SR) then Found:=0;
 End;
 Windows.FindClose(Found);
End;


---

← →
V.exeR ©   (2005-08-09 10:51) [4]

2 Ботвин Дмитрий: и что скажешь?..

---

← →
ANB ©   (2005-08-09 11:22) [5]

> V.exeR ©   (09.08.05 10:51) [4]
- нарывался я на схожую проблему. В конце концов сделал через RemoveDirectory и рекурсию. На форуме мастера подсказали, что :
1. В конце имени папки нужно лепить 2 #0.
2. Неплохо бы разделять путь двумя слешами (очень сомневался, но работать стало лучше).
Воспользоваться советами я не успел, так как уже все переписал.

---

← →
V.exeR ©   (2005-08-09 11:56) [6]

Да, изначально было
Temp:=StringReplace(ExcludeTrailingBackslash(ExtractFilePath(GetPath(tvLibrary.Selected))),":\",":\\",[rfReplaceAll]);

или надо по всему пути "\" заменять на "\\"?

Двойной #0 прилепил, это я пока экспериментировал, потерялось где-то. Но проблема осталась... А через RemoveDirectory удалять нельзя, мне надо чтобы удалялось в корзину если она включена.

---

← →
MetalFan ©   (2005-08-09 12:34) [7]

вот выдержка из MSDN по теме:

typedef struct _SHFILEOPSTRUCT {
   HWND hwnd;
   UINT wFunc;
   LPCTSTR pFrom;
   LPCTSTR pTo;
   FILEOP_FLAGS fFlags;
   BOOL fAnyOperationsAborted;
   LPVOID hNameMappings;
   LPCTSTR lpszProgressTitle;
} SHFILEOPSTRUCT, *LPSHFILEOPSTRUCT
...
pFrom
Address of a buffer to specify one or more source file names. These names must be fully qualified paths. Standard Microsoft® MS-DOS® wild cards, such as "*", are permitted in the file-name position. Although this member is declared as a null-terminated string, it is used as a buffer to hold multiple file names. Each file name must be terminated by a single NULL character. An additional NULL character must be appended to the end of the final name to indicate the end of pFrom.


как раз про "#0#0"

---

← →
Tesla   (2005-08-09 13:02) [8]

А SetCurrentDirectory/GetCurrentDirectory не помогут?

---

← →
V.exeR ©   (2005-08-09 13:40) [9]

Tesla> А SetCurrentDirectory/GetCurrentDirectory не помогут?

Чем?...

2 MetalFan: Я помню help, с #0#0 все ясно, проблема в другом (см. первый пост).

---

← →
ANB ©   (2005-08-09 14:16) [10]

> V.exeR ©   (09.08.05 11:56) [6]
- тогда все \ на \\ заменяли. Вроде, помогло. Я даже вычислил, почему одного #0 мало. Начинает хватать мусор, ессно, неправильно определяет устройство и функция вертает "файл занят" или "не существует" или еще какой бред.

---

← →
V.exeR ©   (2005-08-09 15:15) [11]

Сделал тестовую прогу которая стирает только эту папку - все работает, в программе по-прежнему продолжает утверждать что кто-то эту папку юзает... Я все же склоняюсь к тому что сложность в предварительном сканировании каталогов... Или все-таки еще есть соображения у мастеров? Или подскажите альтернативный способ удаления в корзину каталога.

---

← →
Anatoly Podgoretsky ©   (2005-08-09 15:57) [12]

V.exeR ©   (09.08.05 15:15) [11]
Отсюда делаем вывод, что ошибка в программе. Альтернативный путь ты только что проверил - работает.

---

← →
V.exeR ©   (2005-08-09 19:48) [13]

Но при каких условиях она возникает?.. Как ее убрать?.. Убрал сканирование каталогов (процедура BuildTree) - все отработало. Ткните пожалуйста меня носом где я туплю?...

---

← →
Anatoly Podgoretsky ©   (2005-08-09 20:47) [14]

Когда ты пытаешься удалить что то занятое.

---

← →
ANB ©   (2005-08-09 20:50) [15]

> V.exeR ©   (09.08.05 19:48) [13]
- таки ты где то что то из своей проги открыл и не закрыл.

---

← →
V.exeR ©   (2005-08-09 22:06) [16]

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

---

← →
Anatoly Podgoretsky ©   (2005-08-09 22:12) [17]

Что здесь ChDir(AppDir);

---

← →
ANB ©   (2005-08-09 22:18) [18]

> V.exeR ©   (09.08.05 22:06) [16]

Если убрать вызов BuildTree(OpenDialog.InitialDir+"\DataBase\",nil); - начинает работать ?

---

← →
V.exeR ©   (2005-08-09 22:46) [19]

2 Anatoly Podgoretsky: ChDir(AppDir); вертает текущий каталог в директорию программы на всякий случай (я думал из-за этого не стирается папка).

2 ANB: Нет, если перед вызовом bDelDateClick (процедурой удаления) не вызывать BuildTree, что делается вообще-то при запуске программы.
Суть такая: в TTreeView отображается дерево каталогов, можно любой узел этого TTreeView выбрать кликнув по нему мышкой и удалить через контекстное меню (соответственно этот каталог должен удаляться и с диска). После этого дерево директорий очищается и перестраивается заново (можно конечно и без пересчитывания но роли не играет - я проверял, все равно стирать не хочет).

---

← →
ANB ©   (2005-08-09 22:54) [20]

Тогда еще проэкспериментируй - запусти свою прогу и попробуй из проводника удалить вложенную папку. Сначала стань в дереве на нее.

---

← →
V.exeR ©   (2005-08-09 23:05) [21]

Запускаю, еще никуда не кликаю, пытаюсь из проводника стереть любой "подотчетный" каталог - наступаю на те же грабли. Значит первый мой диагноз был верен: бага в сканировании каталогов. Вот только что там не так, я понять не могу. Чуть ли не хрестоматийный пример, так почему прога каталоги "держит" после сканирования?..

---

← →
ANB ©   (2005-08-10 07:14) [22]

Попробуй переписать через FindFirst, FindNext, FindClose. Могу кинуть рабочий пример для рекурсивного удаления, сам подправишь его для сканирования. Весьма вероятно, что ты где то теряешь хендл или не закрываешь его.

---

← →
V.exeR ©   (2005-08-10 08:42) [23]

2 ANB: Кидай. Можно мылом. Буду очень благодарен.

---

← →
ANB ©   (2005-08-10 09:35) [24]

function RecurseDeleteFolder(sFrom : String; var fmLog : TfmLog) : String;
var SearchRec: TSearchRec;
   FileAttrs, rc, Err : Integer;
   sName, sFullNameFrom, sErrMsg : String;
begin
Result := "";
{Рекурсивный поиск списка папок}
if (fmLog.bStop) then Exit;

FileAttrs := 1 + faDirectory
+faHidden+faArchive+faAnyFile;

rc:= SysUtils.FindFirst(sFrom + "*.*", FileAttrs, SearchRec);
if (rc = 0) then begin
 repeat
  if (fmLog.bStop) then Break;
  sName := SearchRec.Name;
  if ((sName <> ".") and (sName <> ".."))
  then begin
   sFullNameFrom := sFrom + sName;
   if ((SearchRec.Attr and faDirectory) <> 0) then begin
    // Папки
    // Вызовем сами себя рекурсивно
    sErrMsg := RecurseDeleteFolder(sFullNameFrom + "\", fmLog);
    if (sErrMsg <> "") then begin
     Result := sErrMsg;
     Exit;
    end;
   end else begin
    // Файлы удалим
    // Сбросим флаги
    if (not SetFileAttributes(PChar(sFullNameFrom), 0))
    then begin
     Err := GetLastError;
     sErrMsg := SysErrorMessage(Err);
     Result := "Ошибка при сбросе атрибутов файла ""
     + sFullNameFrom
     + "" ("
     + IntToStr(Err) + ") ""
     + sErrMsg + """;
     Exit;
    end;
    // Удалим
    if (not DeleteFile(PChar(sFullNameFrom)))
    then begin
     Err := GetLastError;
     sErrMsg := SysErrorMessage(Err);
     Result := "Ошибка при удалении файла ""
     + sFullNameFrom
     + "" ("
     + IntToStr(Err) + ") ""
     + sErrMsg + """;
     Exit;
    end;
   end;
  end;
  if (fmLog.bStop) then Break;
 until FindNext(SearchRec) <> 0;
 FindClose(SearchRec);
end;
// Удалим папку
// Уберем из имени слеш
sFullNameFrom := LeftStr(sFrom, Length(sFrom) - 1);
if (not RemoveDirectory(PChar(sFullNameFrom)))
then begin
 Err := GetLastError;
 sErrMsg := SysErrorMessage(Err);
 Result := "Ошибка при удалении папки ""
 + sFullNameFrom
 + "" ("
 + IntToStr(Err) + ") ""
 + sErrMsg + """;
end;
end;

---

← →
V.exeR ©   (2005-08-10 10:03) [25]

Заработало, спасибо ANB!


Procedure TMainForm.BuildTree(Path: String; Node: TTreeNode);
Var Found: Integer;
   SR: TSearchRec;
   kk: Cardinal;
   Temp: String;
   NNode: TTreeNode;
Begin
 Found:=SysUtils.FindFirst(Path+"*.*",1 + faDirectory+faHidden+faArchive+faAnyFile,SR);
 While Found=0 Do
 With SR Do
 Begin
   If (Attr and faDirectory=0) and ((UpperCase(ExtractFileExt(Name))=".DAT") or (UpperCase(ExtractFileExt(Name))=".TXT")) Then
   Begin
     Temp:=ExtractFileName(Name);
     NNode:=tvLibrary.Items.AddChild(Node,Temp);
     NNode.SelectedIndex:=9;
     NNode.ImageIndex:=9;
     NNode.StateIndex:=9;
   End Else
   If (Attr and faDirectory>0) Then
   Begin
     If SR.Name[1]<>"." Then
     Begin
       NNode:=Node;
       Node:=tvLibrary.Items.AddChild(NNode,Name);
       If Node.Level=0 Then
       Begin
         Node.SelectedIndex:=7;
         Node.ImageIndex:=7;
         Node.StateIndex:=7;
       End Else
       Begin
         Node.SelectedIndex:=8;
         Node.ImageIndex:=8;
         Node.StateIndex:=8;
       End;
       BuildTree(Path+Name+"\",Node);
       Node:=NNode;
     End;
   End;
   Found:=FindNext(SR);
 End;
 SysUtils.FindClose(SR);
End;


Видимо в предыдущем варианте произошло "смешение" процедур - допустим, поиск открывался процедурами модуля Windows, а закрыть пытался процедурами SysUtils, или наоборот.

Еще раз всем спасибо.

---

Страницы: 1 вся ветка

Скачать: CL | DM;



Память: 0.52 MB
Время: 0.029 c