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

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

В каком модуле описана DeleteFolder

TStas ©   (2006-02-24 23:43:00) 

А то приходится писать самому. CopyFolder написал сразу и без запинок, а здесь заприночка естьь - удаляет все, за исключением самой себя.
И второй вопрос: Нельзя ли как-то снять у всей папки атрибуты только чтение, а то очень неприятно делать это руками, кагда папка переписана с диска

---

Джо   (2006-02-25 00:07:00) [1]

Сорри, под рукой не оказалось реального исходника, поэтому запостил копию чернового (тот, который когда-то в форум выкладывал). В реальном было как-то так:


type
 EDeleteFileSystemObjectError = class (Exception);
...
procedure PurgeDir (const DirName: TFileName; DeleteRoot: Boolean = True);
var
 DirList,
 FileList: TStrings;
 I: Integer;
 Fn: string;
begin
 DirList := TStringList.Create;
 try
   FileList := TStringList.Create;
   try
     ScanDirectory(DirName,FileList,DirList);

     try
       // Delete all files
       for I := FileList.Count-1 downto 0 do
       begin
         Fn := FileList[I];
         if not DeleteFile(Fn) then
           RaiseLastOSError;
       end;

       // Delete all directories
       for I := DirList.Count-1 downto 0 do
       begin
         Fn := DirList[I];
         if not RemoveDir(Fn) then
           RaiseLastOSError;
       end;

       // Delete a root, if specified
       if DeleteRoot then
       begin
         Fn := DirName;
         if not RemoveDir(Fn) then
           RaiseLastOSError;
       end;

       except
         on E: EOSError do
           raise EDeleteFileSystemObjectError.CreateFmt('Error deleting: %s (%s)',[Fn,E.Message])
         else
           raise
       end;
   finally
     FileList.Free;
   end;
 finally
   DirList.Free;
 end;
end;


Всё куда-то тороплюсь...

---

TStas   (2006-02-24 23:56:00) [2]

Джо, глянь в начинающих, ну чего ж не хочет саму-то папку удалять. За ответ спасибо огромное

---

Джо   (2006-02-24 23:49:00) [3]

> TStas ©   (24.02.06 23:43)

По п.1 — В стандартных модулях такой нет. Я для себя делал так:

procedure ScanDirectory (const Root: TFileName; const
 FileLst,DirLst: TStrings);
var
 DirInfo: TSearchRec;
 FileAttr: Word;
begin
 FileAttr := faDirectory;
 if FindFirst(Root+'\*.*',FileAttr,DirInfo) = 0 then
 begin
   repeat
     if (DirInfo.Attr and FileAttr) <> 0 then
     begin
       if (DirInfo.Name <> '.') and (DirInfo.Name <> '..') then
       begin
         DirLst.Add(Root+'\'+ DirInfo.Name);
         ScanDirectory(Root+'\'+ DirInfo.Name,FileLst,DirLst);
       end
     end
     else
       FileLst.Add(Root+'\'+DirInfo.Name);
   until FindNext(DirInfo) <> 0;
 end;
 FindClose (DirInfo);
end;

procedure PurgeDir(const DirName: TFileName; DeleteRoot: Boolean = True);
var
 DirList,
 FileList: TStrings;
 I: Integer;
begin
 DirList := TStringList.Create;
 try
   FileList := TStringList.Create;
   try
     ScanDirectory(DirName,FileList,DirList);

     for I := FileList.Count-1 downto 0 do
       DeleteFile(FileList[I]);

     for I := DirList.Count-1 downto 0 do
       RemoveDir(DirList[I]);

     if DeleteRoot then
       RemoveDir(DirName)
   finally
     FileList.Free;
   end;
 finally
   DirList.Free;
 end;
end;

(Хотя кое-кто над этим кодом тут посмеивался, меня он устраивает :^)

---

Наверх