Удалении директории при удалении записи

← →
любитель (2006-11-09 18:51) [0]

Во время добавлении записи в базу помещаю путь добавленного файла (поле Dir )и создаю папку (формата 200611091628)куда этот файл копируеться, как мне при удалении этой записи удалить и папку с этим файлом

← →
Ketmar © (2006-11-09 18:58) [1]

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

← →
Любитель (2006-11-10 12:49) [2]

создаеться папка такого вида
в папке программы \Files\200611091628 в базу записываеться поле Dir (200611091628)

исп функцию
[code]
//Удаление каталога со всем содержимым
function DeleteDir(Dir: string): boolean;
var
Found: integer;
SearchRec: TSearchRec;
begin
result := false;
if IOResult <> 0 then
ChDir(Dir);
if IOResult <> 0 then
begin
ShowMessage("Не могу войти в каталог: " + Dir);
exit;
end;
Found := FindFirst("*.*", faAnyFile, SearchRec);
while Found = 0 do
begin
if (SearchRec.name <> ".") and (SearchRec.name <> "..") then
if (SearchRec.Attr and faDirectory) <> 0 then
begin
if not DeleteDir(SearchRec.name) then
exit;
end
else
if not DeleteFile(SearchRec.name) then
begin
ShowMessage("Не могу удалить файл: " + SearchRec.name);
exit;
end;
Found := FindNext(SearchRec);
end;
FindClose(SearchRec);
ChDir("..");
RmDir(Dir);
result := IOResult = 0;
end;
[/code]

[code]
procedure TFmain.ADOQuery1AfterDelete(DataSet: TDataSet);
begin
if DirectoryExists("Files\" + (fmain.ADOQuery1.FieldValues["Dir"])) then
DeleteDir ( "Files\" + (fmain.ADOQuery1.FieldValues["Dir"]))
[/code]

Вываливаеться по ошибке
EInOutError with message "I/O error 145"

ceval

← →
Ketmar © (2006-11-10 12:52) [3]

ну так "папка не пуста". что неясно?

← →
Любитель (2006-11-10 12:54) [4]

Ну так функция - //Удаление каталога со всем содержимым

← →
sniknik © (2006-11-10 13:57) [5]

вообще в BDE вроде была проблема, каталог блокировался, даже после закрытия коннектов/сессий к нему (он же вроде как база для локальных файлов)...
в общем посмотри, если после закрытия таблицы/коннекта ты даже руками (в проводнике) не можеш удалить каталог, пока программа работает... это оно.

выход можно придумать, например подключатся к базе/каталогу родителю (\Files), а 200611091628 указывать в запросе, в имени файла.
(код не смотрел, ошибка может и в нем...)

← →
Любитель (2006-11-10 14:44) [6]

Нет посмотрел когда программа открыта то можно в ручную удалить этот каталог он не блокируеться

← →
Любитель (2006-11-10 16:23) [7]

Вот другую функцию попробывал она нормально отрабатывает но не удаляет директорию
function DeleteDir(Dir: string): boolean; var Found: integer; SearchRec: TSearchRec; begin result := false; if IOResult <> 0 then ChDir(Dir); if IOResult <> 0 then begin ShowMessage("Не могу войти в каталог: " + Dir); exit; end; Found := FindFirst("*.*", faAnyFile, SearchRec); while Found = 0 do begin if (SearchRec.name <> ".") and (SearchRec.name <> "..") then if (SearchRec.Attr and faDirectory) <> 0 then begin if not DeleteDir(SearchRec.name) then exit; end else if not DeleteFile(SearchRec.name) then begin ShowMessage("Не могу удалить файл: " + SearchRec.name); exit; end; Found := FindNext(SearchRec); end; FindClose(SearchRec); ChDir(".."); RmDir(Dir); result := IOResult = 0; end; procedure TFmain.ADOQuery1AfterDelete(DataSet: TDataSet); begin if DirectoryExists("Files\" + TrimRight(fmain.ADOQuery1.FieldValues["Dir"])) then DeleteDir ( "Files\" + TrimRight(fmain.ADOQuery1.FieldValues["Dir"])) end;

← →
ANB © (2006-11-10 16:30) [8]

Немного кривенько, но работает :

procedure TFormMakeDistrMain.RecurseDeleteFolder(sFrom: String); var SearchRec: TSearchRec; FileAttrs, rc, Err : Integer; sName, sFullNameFrom, sErrMsg : String; begin {Рекурсивный поиск списка папок} if (not bRun) then Exit; FileAttrs := 1 + faDirectory +faHidden+faArchive+faAnyFile; rc:= SysUtils.FindFirst(sFrom + "*.*", FileAttrs, SearchRec); if (rc = 0) then begin repeat if (not bRun) then Break; sName := SearchRec.Name; if ((sName <> ".") and (sName <> "..")) then begin sFullNameFrom := sFrom + sName; if ((SearchRec.Attr and faDirectory) <> 0) then begin // Папки // Вызовем сами себя рекурсивно RecurseDeleteFolder(IncludeTrailingPathDelimiter(sFullNameFrom)); end else begin // Файлы удалим // Сбросим флаги if (not SetFileAttributes(PChar(sFullNameFrom), 0)) then begin Err := GetLastError; sErrMsg := SysErrorMessage(Err); WriteToLogRes("Ошибка при сбросе атрибутов файла "" + sFullNameFrom + "" (" + IntToStr(Err) + ") "" + sErrMsg + """); Exit; end; // Удалим if (not DeleteFile(PChar(sFullNameFrom))) then begin Err := GetLastError; sErrMsg := SysErrorMessage(Err); WriteToLogRes("Ошибка при удалении файла "" + sFullNameFrom + "" (" + IntToStr(Err) + ") "" + sErrMsg + """); Exit; end; end; end; if (not bRun) then Break; until FindNext(SearchRec) <> 0; FindClose(SearchRec); end; // Удалим папку // Уберем из имени слеш sFullNameFrom := ExcludeTrailingPathDelimiter(sFrom); if (not RemoveDirectory(PChar(sFullNameFrom))) then begin Err := GetLastError; sErrMsg := SysErrorMessage(Err); WriteToLogRes("Ошибка при удалении папки "" + sFullNameFrom + "" (" + IntToStr(Err) + ") "" + sErrMsg + """); end; end;

Почисти, что компиляться не будет. На вход подавать имя папки со слешом в конце.

← →
Любитель (2006-11-10 17:07) [9]

Ругаеться на bRun

такой вызов
RecurseDeleteFolderr ( "Files\" + TrimRight(fmain.ADOQuery1.FieldValues["Dir"]) + "\")

← →
ANB © (2006-11-10 17:10) [10]

> Любитель (10.11.06 17:07) [9]

Я ж сказал - выкини лишнее. bRun - флаг, чтобы можно было кнопкой стоп прервать все это безобразие.
Еще лишней будет WriteToLogRes. Это я функцию для вывода в лог рисовал.
Я дал кусок рабочего кода. Лень его чистить было.

← →
ANB © (2006-11-10 18:10) [11]

> Любитель (10.11.06 17:07) [9]

Путь желательно подавать полный. С относительным я не проверял. Для приклейки слеша в конце есть специальная функция - она делает это аккуратнее (пример есть в моем коде).

← →
Любитель (2006-11-13 11:28) [12]

пОМОГИТЕ РАЗОБРАТЬСЯ, использую такую функцию
в базу записываеться такого формата Dir ( 200611131003)

function DeleteDir(Dir : string) : boolean; Var Found : integer; SearchRec : TSearchRec; begin result:=false; if IOResult<>0 then ; ChDir(Dir); if IOResult<>0 then begin ShowMessage("Не могу войти в каталог: "+Dir); exit; end; Found := FindFirst("*.*", faAnyFile, SearchRec); while Found = 0 do begin if (SearchRec.Name<>".")and(SearchRec.Name<>"..") then if (SearchRec.Attr and faDirectory)<>0 then begin if not DeleteDir(SearchRec.Name) then exit; end else if not DeleteFile(SearchRec.Name) then begin ShowMessage("Не могу удалить файл: "+SearchRec.Name); exit; end; Found := FindNext(SearchRec); end; FindClose(SearchRec); ChDir(".."); RmDir(Dir); result:=IOResult=0; end; procedure TFmain.ADOQuery1AfterDelete(DataSet: TDataSet); begin if DirectoryExists(ExtractFilePath(Application.EXEName)+ "Files\" + (fmain.ADOQuery1.FieldValues["Dir"])) then DeleteDir(ExtractFilePath(Application.EXEName) + "Files\" + (fmain.ADOQuery1.FieldValues["Dir"])) else Showmessage("Директория не существеут или уже удаленна") end;

НЕ удаляет директорию а поторобвал просто в ручную вписать 200611131003
все нормально удаляет

← →
ANB © (2006-11-13 11:34) [13]

> Любитель (13.11.06 11:28) [12]

Посмотри на код ошибки. Скорее всего у тебя дирректория не пустая. Или занята какой то программой.

← →
Любитель (2006-11-13 12:42) [14]

Нету ни какой ошибки просто удаляеться запись а директория остаеться

Да директория не пустая

← →
ANB © (2006-11-13 12:51) [15]

Непустую директорию удалить низзя. Почитай описание команды RmDir.
И как ты проверял наличие ошибки ?
ЗЫ. Возьми мою процедуру, подкрути и не парься. Она не сможет удалить только в случае, если директория занята. Но при этом ругнется.

← →
ANB © (2006-11-13 12:51) [16]

Кстати, а причем тут базы данных ?

← →
Любитель (2006-11-13 13:57) [17]

хорошо попробую
>Кстати, а причем тут базы данных ?
ADOQuery1.FieldValues["Dir"]

← →
Любитель (2006-11-13 14:09) [18]

хорошо попробую
>Кстати, а причем тут базы данных ?
ADOQuery1.FieldValues["Dir"]

Бред какой-то
procedure RecurseDeleteFolder(sFrom: String); var SearchRec: TSearchRec; FileAttrs, rc, Err : Integer; sName, sFullNameFrom, sErrMsg : String; begin {Рекурсивный поиск списка папок} FileAttrs := 1 + faDirectory +faHidden+faArchive+faAnyFile; rc:= SysUtils.FindFirst(sFrom + "*.*", FileAttrs, SearchRec); if (rc = 0) then begin repeat sName := SearchRec.Name; if ((sName <> ".") and (sName <> "..")) then begin sFullNameFrom := sFrom + sName; if ((SearchRec.Attr and faDirectory) <> 0) then begin // Папки // Вызовем сами себя рекурсивно RecurseDeleteFolder(IncludeTrailingPathDelimiter(sFullNameFrom)); end else begin // Файлы удалим // Сбросим флаги if (not SetFileAttributes(PChar(sFullNameFrom), 0)) then begin Err := GetLastError; sErrMsg := SysErrorMessage(Err); end; // Удалим if (not DeleteFile(PChar(sFullNameFrom))) then begin Err := GetLastError; sErrMsg := SysErrorMessage(Err); Exit; end; end; end; until FindNext(SearchRec) <> 0; FindClose(SearchRec); end; // Удалим папку // Уберем из имени слеш sFullNameFrom := ExcludeTrailingPathDelimiter(sFrom); if (not RemoveDirectory(PChar(sFullNameFrom))) then begin Err := GetLastError; sErrMsg := SysErrorMessage(Err); end; end; procedure TFmain.ADOQuery1AfterDelete(DataSet: TDataSet); begin if DirectoryExists(ExtractFilePath(Application.EXEName)+ "Files\" + (fmain.ADOQuery1.FieldValues["Dir"])) then RecurseDeleteFolder(ExtractFilePath(Application.EXEName) + "Files\" + (fmain.ADOQuery1.FieldValues["Dir"])+"\")

>ЗЫ. Возьми мою процедуру, подкрути и не парься. Она не сможет удалить только в случае, если директория занята. Но при этом ругнется.

Все тоже самое удаляет строку а директорию не трогает

← →
Anatoly Podgoretsky © (2006-11-13 14:30) [19]

> Любитель (13.11.2006 13:57:17) [17]

Это что основание? :-)

--

← →
ANB © (2006-11-13 14:48) [20]

> Любитель (13.11.06 14:09) [18]

Возьми заново мою функцию и замени в ней WriteToLogRes на ShowMessage
и опять убери bRun. Впрочем, еще лучше заведи переменную или свойство формы с таким именем bRun : Boolean; Перед запуском процедуры установи его в True;

← →
Amoeba © (2006-11-13 15:09) [21]

А если посмотреть в сторону функции SHFileOperation?
http://www.delphikingdom.com/asp/viewitem.asp?catalogid=91

> А если посмотреть в сторону функции SHFileOperation?

Ну это слишком просто и тривиально.

> Amoeba © (13.11.06 15:09) [21]

Если честно - ее чаще клинит. Я уже пробовал ее, но рекурсивно чистить оказалось надежнее. Хотя очень заманчиво - все одним оператором да еще и в корзину.

← →
Любитель (2006-11-13 16:48) [24]

Все спасиба всем за помощь и терпение особенно ANB
изменил ADOQuery1AfterDelete на ADOQuery1BeforeDelete
и сделал как сказал ANB [20] все заработал

← →
Любитель (2006-11-13 17:37) [25]

Тут возник у меня такой баг
procedure TFmain.ADOQuery1BeforeDelete(DataSet: TDataSet); begin bRun:=true; if DirectoryExists(ExtractFilePath(Application.EXEName)+ "Files\" + (fmain.ADOQuery1.FieldValues["Dir"])) then begin RecurseDeleteFolder(ExtractFilePath(Application.EXEName) + "Files\" + (fmain.ADOQuery1.FieldValues["Dir"])+ "\") ; Showmessage("Запись удаленна вместе с вложенными файлами"); end else Showmessage("Запись удаленна") end;
когда удаляешь строчку в которой нет директории то через раз выдает
process cannot access the file because it is being used by another proccess
( процесс не может получить доступ к файлу, потому что это используется другим proccess)
похоже это возникает после того как удалил строку с директорией а потом строку без директории и удаление директории происходит только после закрытия самой программы

← →
Любитель (2006-11-13 18:19) [26]

и еще если в дириктории Files нет нечего то полностью удаляеться она

> Любитель (13.11.06 18:19) [26]

Дык так и должно быть, если у тебя в поле Dir пусто. Поставь проверки на :
1. Отсутствие папки на диске
2. Пустоте в поле Dir.
ЗЫ. Кстати, доступ к полю БД не самая шустрая операция. Да и код длиннее. Скопируй его значение в обычную переменную.
ЗЫЫ. Лучше юзать FieldByName("Dir").AsString. Оно понадежнее как то. Хотя ИМХО это.

← →
Любитель (2006-11-14 15:47) [28]

Спасиба ANB
а вот как сделать что бы дириктории Files не удалялась хотя в ней и нечего нет

> Любитель (14.11.2006 15:47:28) [28]

Удалять не папку, а содержимое папки

← →
Любитель (2006-11-14 16:05) [30]

Все спасиба вроде решил
if ADOQuery1.FieldByName("Dir").AsString="" then Showmessage("Запись удаленна") else if DirectoryExists(ExtractFilePath(Application.EXEName)+ "Files\" + (fmain.ADOQuery1.FieldValues["Dir"])) then begin RecurseDeleteFolder(ExtractFilePath(Application.EXEName) + "Files\" + (fmain.ADOQuery1.FieldValues["Dir"])+ "\") ; Showmessage("Запись удаленна вместе с вложенными файлами"); end;

если в поле Dir пусто то просто удаляем строку
иначе
если существует дириктория указанная в поле Dir
то удаляем ее

Удалении директории при удалении записи Найти похожие ветки