| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Удалении директории при удалении записи [D7, Access]

Страницы:   < 1 2 >

любитель ©   (2006-11-09 18:51:00) 

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

---

ANB   (2006-11-10 17:10:00) [21]

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

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

---

Любитель   (2006-11-10 17:07:00) [22]

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

такой вызов

RecurseDeleteFolderr ( 'Files\' + TrimRight(fmain.ADOQuery1.FieldValues['Dir']) + '\')

---

ANB   (2006-11-10 16:30:00) [23]

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


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 16:23:00) [24]

Вот другую функцию попробывал она нормально отрабатывает но не удаляет директорию

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;


---

Любитель   (2006-11-10 14:44:00) [25]

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

---

sniknik   (2006-11-10 13:57:00) [26]

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

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

---

Любитель   (2006-11-10 12:54:00) [27]

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

---

Ketmar   (2006-11-10 12:52:00) [28]

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

---

Любитель   (2006-11-10 12:49:00) [29]

создаеться папка такого вида
в папке программы  \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-09 18:58:00) [30]

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

---

Страницы:   < 1 2 >

Наверх