Форум: "Начинающим";
Текущий архив: 2006.03.12;
Скачать: [xml.tar.bz2];

Вниз

В каком модуле описана DeleteFolder   Найти похожие ветки 

← →
TStas ©   (2006-02-24 23:43) [0]

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

---

← →
Джо ©   (2006-02-24 23:49) [1]

> 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;

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

---

← →
TStas ©   (2006-02-24 23:56) [2]

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

---

← →
Джо ©   (2006-02-25 00:07) [3]

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


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;


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

---

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

Форум: "Начинающим";
Текущий архив: 2006.03.12;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.01 c