Не удаляется каталог функцией 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);

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

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

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

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

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

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

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

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

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;

Заработало, спасибо 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, или наоборот.

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

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