Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "WinAPI";
Текущий архив: 2005.09.11;
Скачать: [xml.tar.bz2];

Вниз

Как удалить дирректорию с файлами?   Найти похожие ветки 

 
Zak3D[@Tm] ©   (2005-07-22 13:24) [0]

Собственно нужна помощь по решению сабжа =).


 
Anatoly Podgoretsky ©   (2005-07-22 13:26) [1]

ShFileOperation


 
alpet ©   (2005-07-22 13:32) [2]

из командной строки (утилита deltree есть в составе Win98):
deltree dirname.

Используя функцию ShellAPI:

var fs: SHFILEOPSTRUCT;
begin
fs.hwnd := 0;
fs.wFunc := FO_DELETE;
fs.pFrom := "X:\Windows"; // select your folder to delete
fs.pTo := nil;
fs.flags := FOF_NOCONFIRMATION + FOF_NOERRORUI + FOF_SILENT;
fs.hNameMappings := 0;
fs.lpszProgressTitle := nil;
SHFileOperation (fs);
end;


 
Джо ©   (2005-07-22 13:45) [3]

Ежли не заморачиваться насчет WinAPI, то можно навернуть вот такое рекурсивное удаление:


unit ScanUtils;

interface
uses SysUtils, Classes;

// осторожно, удаляет все вложенные под-директории и файлы  :0)
// Параметр DeleteRoot определяет, удалять ли саму указанную директорию

procedure PurgeDir (const DirName: TFileName; DeleteRoot: Boolean = True);

implementation

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;

end.



 
Anatoly Podgoretsky ©   (2005-07-22 13:49) [4]

Ну ни фига ты и накрутил, а еще про заморочки что то говоришь. Главное и ближайшей ошибке выскочишь из исполнения.


 
Джо ©   (2005-07-22 13:51) [5]


>  [4] Anatoly Podgoretsky ©   (22.07.05 13:49)

Анализ ошибок предоставляю производить автору топика, дабы суть примера была ясна.
А накрутил нормально, обычный рекурсивный обход всего дерева вложенности.


 
Fay ©   (2005-07-22 14:10) [6]

2 Джо ©   (22.07.05 13:45) [3]
Просто на редкость некрасивое решение.


 
Джо ©   (2005-07-22 14:13) [7]


>  [6] Fay ©   (22.07.05 14:10)
> Просто на редкость некрасивое решение.

Зато чрезвычайно понятное и прозрачное. В моей системе понятий это означает "красивое". Но раз уж зашла речь, приведи свое.


 
Fay ©   (2005-07-22 14:33) [8]

2 Джо ©   (22.07.05 14:13) [7]

ОК

procedure TForm1.DelDir(cDir : string);
var
 h : THandle;
 fd : _WIN32_FIND_DATAA;
 fn, s : string;
begin
 h := FindFirstFile(PChar(cDir + "\*"), fd);
 if h = INVALID_HANDLE_VALUE then
   RaiseLastOSError;
 repeat
   fn := fd.cFileName;
   s := cDir + "\" + fn;
   if (fd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
     begin
       if not Windows.DeleteFile(PChar(s)) then
         RaiseLastOSError;
     end
   else if (string(fn) <> ".") and (string(fn) <> "..") then
     DelDir(s);
 until not FindNextFile(h, fd);
 Windows.FindClose(h);
 if not RemoveDirectory(PChar(cDir)) then
   RaiseLastOSError;
end;

procedure TForm1.Button1Click(Sender : TObject);
begin
 DelDir(edDir.Text);
end;


 
Джо ©   (2005-07-22 14:42) [9]


>  [8] Fay ©   (22.07.05 14:33)

На мой вкус - некрасивое решение. Решаются 2 разные задачи - рекурсивный обход + удаление. Я предпочитаю их для ясности не сливать в одну.


 
Fay ©   (2005-07-22 14:44) [10]

2 Джо ©   (22.07.05 14:42) [9]
Дя... Тяжкий случай...


 
Fay ©   (2005-07-22 14:48) [11]

2 Джо ©   (22.07.05 14:42) [9]
>> Решаются 2 разные задачи
Решается одна задача - "как удалить дирректорию с файлами?".


 
Джо ©   (2005-07-22 14:51) [12]


> [9] Джо ©   (22.07.05 14:42)

Более того, функцию PurgeDir я, в первом приближении к рабочему варианту сделал бы даже так:

procedure PurgeDir (const DirName: TFileName; DeleteRoot: Boolean = True);
var
DirList,
FileList: TStrings;

procedure DeleteFiles (AFiles: TStrings);
var
  I: Integer;
begin
  for I := 0 to AFiles.Count-1 do
    if not DeleteFile (AFiles[I]) then
      raise Exception.Create("Can not delete file specified");
end;

procedure DeleteDirectories (ADirs: TStrings);
var
  I: Integer;
begin
  for I := 0 to ADirs.Count-1 do
    if not RemoveDir(ADirs[I]) then
      raise Exception.Create("Can not delete a directory specified");
end;

begin
DirList := TStringList.Create;
try
  FileList := TStringList.Create;
  try
    ScanDirectory(DirName,FileList,DirList);
    DeleteFiles(FileList);
    DeleteDirectories(DirList);

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


 
Fay ©   (2005-07-22 14:52) [13]

string(fn) - приведение, конечно, лишнее.
Забыл убрать после заведения переменной fn 8)


 
Джо ©   (2005-07-22 14:54) [14]


> [11] Fay ©   (22.07.05 14:48)
> 2 Джо ©   (22.07.05 14:42) [9]
> >> Решаются 2 разные задачи
> Решается одна задача - "как удалить дирректорию с файлами?".

В таком случае, любую программу можно сделать в виде одной большой процедуры, решающей одну прикладную задачу. Успехов.


 
Джо ©   (2005-07-22 15:02) [15]


> [10] Fay ©   (22.07.05 14:44)
> 2 Джо ©   (22.07.05 14:42) [9]
> Дя... Тяжкий случай...

После этого "Я использую GOTO и мне пофиг, что думают об этом остальные" меня не удивляет ваша реакция.


 
Fay ©   (2005-07-22 15:06) [16]

2 Джо ©   (22.07.05 14:54) [14]

>> В таком случае, любую программу можно сделать в виде одной большой процедуры, решающей одну прикладную задачу

Впервые пришло в голову?!
Вы по образованию строитель(лесник, военный, юрист), что ли?


 
Джо ©   (2005-07-22 15:11) [17]


>  [16] Fay ©   (22.07.05 15:06)

Вот вам и предоставляю делать программы по такому рецепту. Тем более, что вы, видимо, к нему очень склонны.
--
П.С. А мои персоналии, будьте добры, обсуждайте где-нибудь за пивом с друзьями, но так, что бы я этого не услышал, пожалуйста.


 
Fay ©   (2005-07-22 15:15) [18]

2 Джо ©   (22.07.05 15:11) [17]
>> П.С. ...
Уже


 
Fay ©   (2005-07-22 15:33) [19]

2 Джо ©   (22.07.05 15:11) [17]
Ладно, извини, если чем досадил.
Настроение не очень и мне не надо было срываться на тебе.
Признаю - бы не прав, хотя код [3] и [12] мне действительно не нравится, ну да это мои проблемы.


 
Zak3D[@Tm] ©   (2005-07-22 15:42) [20]

Спасибо, всё работает =)


 
Джо ©   (2005-07-22 15:43) [21]


>  [19] Fay ©   (22.07.05 15:33)

Да ладно ;-) В таком случае, свои резкие замечания также беру обратно. Надеюсь, настроение уже лучше.


 
Fay ©   (2005-07-22 15:44) [22]

2 Джо ©   (22.07.05 15:43) [21]
Значительно 8)



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

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

Наверх




Память: 0.5 MB
Время: 0.01 c
4-1122099193
***_Diman_***
2005-07-23 10:13
2005.09.11
как отловить DTN_CLOSEUP?


1-1124693266
DVM
2005-08-22 10:47
2005.09.11
Помогите с разбором HTTP ответа сервера (IP-камеры).


1-1124285554
Kirill
2005-08-17 17:32
2005.09.11
Установка компонентов не из под IDE


1-1124393333
Yegorchic
2005-08-18 23:28
2005.09.11
Доступно ли новое имя для компоненты?


2-1123309367
Андрей235
2005-08-06 10:22
2005.09.11
вывести в Caption или text integer переменную или string=integer





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский