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

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

очистка каталога [D7, XP]

Yury ©   (2008-06-12 10:18:00) 

вопрос наверное слишком простой, но все же: как из делфи удалить все файлы из каталога?

---

Riply   (2008-06-13 18:18:00) [1]

> [19] Игорь Шевченко ©   (13.06.08 18:11)
> а то же самое на ассемблере ?

В этом случае меня бы забанили за злостное засорение форума,
а так грозит только простое :)

---

Игорь Шевченко   (2008-06-13 18:11:00) [2]

а то же самое на ассемблере ?

---

Riply   (2008-06-13 17:28:00) [3]

P.S.
Стуктуры выдергивать не стала: и так слишком большой пост получился :)

---

Riply   (2008-06-13 17:25:00) [4]

Вторая часть известного балета :) :

const
DelDirAccess = _DELETE or FILE_DELETE_CHILD or FILE_LIST_DIRECTORY or SYNCHRONIZE;

function Nt_RemoveDirRec(const hDelDir: THandle; DeleteSelf: Boolean): NTSTATUS;
var
IoBlock: IO_STATUS_BLOCK;
pObjInfo: Pointer;
cbObjInfo: DWord;

function _Nt_RemoveDirRec(const hDirecoty: THandle; DelSelf: Boolean): NTSTATUS;
var
 NtNameU: UNICODE_STRING;
 RetStatus, SubFileStatus: NTSTATUS;
 DirHandle: THandle;
 DirAccess: DWord;
 RestartScan: Boolean;
begin
 RestartScan := True;
 Result := STATUS_SUCCESS;
 repeat
  RetStatus := NtQueryDirectoryFileMem(hDirecoty, 0, nil, nil, @IoBlock, pObjInfo, cbObjInfo,
                                       FileDirectoryInformation, True, nil, RestartScan);
  if RetStatus = STATUS_SUCCESS then
   with PFILE_DIRECTORY_INFORMATION(pObjInfo)^ do
    if (FileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
     begin
      Us_InitLen_(@NtNameU, @FileName, FileNameLength);
      if FileAttributes and (FILE_ATTRIBUTE_READONLY or FILE_ATTRIBUTE_SYSTEM) = 0
       then RestartScan := NT_STATUS_SET_WORST(Result, Nt_DeleteFileU(@NtNameU, hDirecoty))
       else RestartScan := NT_STATUS_SET_WORST(Result, Nt_DeleteObjU(@NtNameU, FileAttributes, hDirecoty));
     end
    else
     if Us_IsNotEmptyOrRoot(@FileName, FileNameLength shr SHR_WCHAR) then
      begin
       Us_InitLen_(@NtNameU, @FileName, FileNameLength);
       if FileAttributes and (FILE_ATTRIBUTE_READONLY or FILE_ATTRIBUTE_SYSTEM) = 0
        then DirAccess := DelDirAccess
        else DirAccess := DelDirAccess or FILE_WRITE_ATTRIBUTES;
       SubFileStatus := Nt_CreateFile(@NtNameU, DirAccess, @IoBlock, nil, FILE_ATTRIBUTE_DIRECTORY,
                                      0, FILE_OPEN, FILE_DIRECTORY_FILE or FILE_SYNCHRONOUS_IO_NONALERT,
                                      @hDirecoty, nil, DirHandle);
       if SubFileStatus = STATUS_SUCCESS then
        try
         if DirAccess <> DelDirAccess then _Nt_SetObjAttributes(DirHandle, FILE_ATTRIBUTE_NORMAL);
         RestartScan := NT_STATUS_SET_WORST(Result, _Nt_RemoveDirRec(DirHandle, True));
        finally
         NtClose(DirHandle);
        end
       else
        begin
         RestartScan := False;
         if Result = STATUS_SUCCESS then Result := SubFileStatus;
        end;
      end
     else RestartScan := False
  else
   begin
    NT_STATUS_SET_WORST(Result, RetStatus);
    Break;
   end;
 until RetStatus <> STATUS_SUCCESS;

 if DelSelf then
  if NT_NO_MORE_FILES(Result) then Result := Nt_SetObjDisposInfoDelete(hDirecoty);
end;

begin
cbObjInfo := 1024;
pObjInfo := GetMemory(cbObjInfo);
if pObjInfo <> nil then
 try
  Result := _Nt_RemoveDirRec(hDelDir, DeleteSelf);
 finally
  FreeMem(pObjInfo);
 end
else Result := STATUS_INSUFFICIENT_RESOURCES;
end;

function Nt_RemoveDirRecursivelyU(const pPathForDelete: PUNICODE_STRING; DeleteSelf: Boolean): NTSTATUS;
var
ObjAttr: OBJECT_ATTRIBUTES;
IoBlock: IO_STATUS_BLOCK;
hDirecoty: THandle;
begin
InitializeObjectAttributes(@ObjAttr, pPathForDelete, OBJ_CASE_INSENSITIVE, 0, nil);
if DeleteSelf then
 begin
  Result := NtCreateFile(@hDirecoty, DelDirAccess or FILE_WRITE_ATTRIBUTES, @ObjAttr, @IoBlock, nil,
                         FILE_ATTRIBUTE_DIRECTORY, FILE_SHARE_SH_ALL, FILE_OPEN, FILE_SYNCHRONOUS_IO_NONALERT or FILE_DIRECTORY_FILE, nil, 0);
  if Result = STATUS_SUCCESS then Result := _Nt_SetObjAttributes(hDirecoty, FILE_ATTRIBUTE_NORMAL);
 end
else Result := NtCreateFile(@hDirecoty, DelDirAccess, @ObjAttr, @IoBlock, nil,
                            FILE_ATTRIBUTE_DIRECTORY, FILE_SHARE_SH_ALL, FILE_OPEN, FILE_SYNCHRONOUS_IO_NONALERT or FILE_DIRECTORY_FILE, nil, 0);
if Result = STATUS_SUCCESS then
 try
  Result := Nt_RemoveDirRec(hDirecoty, DeleteSelf);
 finally
  NtClose(hDirecoty);
 end;
end;


---

Riply   (2008-06-13 17:24:00) [5]

Написала для себя небольшую процедуру удаления директории.
Да вот все руки не доходят погонять и потестировать ее по полной программе,
дабы пометить как готовую к употреблению и забыть :)
Чем черт не шутит, может и найдутся желающие выполнить за лентяку ее работу :)
Предупреждаю сразу о паре скользких моментов:
нет проверки на FILE_ATTRIBUTE_REPARSE_POINT и довольно шаткая проверка на '.', '..'.

Если все будет удачно, то в ней заложен большой потенциал для оптимизации
(я запрашивала только по одному объекту при сканировании и,
соответственно, не пыталась управлять порядком удаления, что не есть кузяво :)

Первая часть:

function Nt_RemoveDirRecursivelyU(const pPathForDelete: PUNICODE_STRING; DeleteSelf: Boolean): NTSTATUS;

implementation

const
QUERY_FILE_FS_INC               = $1000;

procedure Us_InitLen_(const pUs: PUNICODE_STRING; const pwSour: PWideChar; const BytesInSource: LongWord);
begin
with pUs^ do
 begin
  Buffer := pwSour;
  Length := BytesInSource;
  MaximumLength := BytesInSource;
 end;
end;

function Nt_SetObjDisposInfoDelete(const FSObjHandle: THandle): NTSTATUS;
var
FileDispInfo: FILE_DISPOSITION_INFORMATION;
IoBlock: IO_STATUS_BLOCK;
begin
FileDispInfo.DeleteFile := True;
Result := NtSetInformationFile(FSObjHandle, @IoBlock, @FileDispInfo,
                               SizeOf(FILE_DISPOSITION_INFORMATION), FileDispositionInformation);
end;

function _Nt_SetObjAttributes(const FSObjHandle: THandle; const cbAttr: DWord): NTSTATUS;
var
FileBaseInfo: FILE_BASIC_INFORMATION;
IoBlock: IO_STATUS_BLOCK;
begin
FillChar(FileBaseInfo, SizeOf(FILE_BASIC_INFORMATION), 0);
FileBaseInfo.FileAttributes := cbAttr;
Result := NtSetInformationFile(FSObjHandle, @IoBlock, @FileBaseInfo,
                               SizeOf(FILE_BASIC_INFORMATION), FileBasicInformation);
end;

function Nt_DeleteObjectFS(const FSObjHandle: THandle; const FileAttr: DWord): NTSTATUS;
var
FileBaseInfo: FILE_BASIC_INFORMATION;
FileDispInfo: FILE_DISPOSITION_INFORMATION;
IoBlock: IO_STATUS_BLOCK;
begin
FileDispInfo.DeleteFile := True;
if (FileAttr and (FILE_ATTRIBUTE_READONLY or FILE_ATTRIBUTE_SYSTEM)) <> 0 then
 begin
  FillChar(FileBaseInfo, SizeOf(FILE_BASIC_INFORMATION), 0);
  FileBaseInfo.FileAttributes := FILE_ATTRIBUTE_NORMAL;
  Result := NtSetInformationFile(FSObjHandle, @IoBlock, @FileBaseInfo,
                                 SizeOf(FILE_BASIC_INFORMATION), FileBasicInformation);
  if Result = STATUS_SUCCESS
   then Result := NtSetInformationFile(FSObjHandle, @IoBlock, @FileDispInfo,
                                       SizeOf(FILE_DISPOSITION_INFORMATION), FileDispositionInformation);
 end
else Result := NtSetInformationFile(FSObjHandle, @IoBlock, @FileDispInfo,
                                    SizeOf(FILE_DISPOSITION_INFORMATION), FileDispositionInformation);
end;

function Nt_DeleteObject(const pObjAttr: POBJECT_ATTRIBUTES; const FileAttr: DWord): NTSTATUS;
var
IoBlock: IO_STATUS_BLOCK;
FileHandle: THandle;
begin
if (FileAttr and FILE_ATTRIBUTE_DIRECTORY) = 0
 then Result := NtCreateFile(@FileHandle, _DELETE or FILE_WRITE_ATTRIBUTES, pObjAttr, @IoBlock, nil,
                        FILE_ATTRIBUTE_NORMAL, FILE_SHARE_SH_ALL, FILE_OPEN, FILE_NON_DIRECTORY_FILE, nil, 0)
 else Result := NtCreateFile(@FileHandle, _DELETE or FILE_WRITE_ATTRIBUTES, pObjAttr, @IoBlock, nil,
                        FILE_ATTRIBUTE_DIRECTORY, 0, FILE_OPEN, FILE_DIRECTORY_FILE, nil, 0);

if Result = STATUS_SUCCESS then
 try
  Result := Nt_DeleteObjectFS(FileHandle, FileAttr);
 finally
  NtClose(FileHandle);
 end;
end;

function Nt_DeleteObjU(const puFileName: PUNICODE_STRING; const cbFileAttr: DWord; const hParentDir: THandle): NTSTATUS;
var
ObjAttr: OBJECT_ATTRIBUTES;
begin
InitializeObjectAttributes(@ObjAttr, puFileName, OBJ_CASE_INSENSITIVE, hParentDir, nil);
Result := Nt_DeleteObject(@ObjAttr, cbFileAttr);
end;

function Nt_DeleteFileU(const puFileName: PUNICODE_STRING; const hParentDir: THandle): NTSTATUS;
var
ObjAttr: OBJECT_ATTRIBUTES;
begin
InitializeObjectAttributes(@ObjAttr, puFileName, OBJ_CASE_INSENSITIVE, hParentDir, nil);
Result := NtDeleteFile(@ObjAttr);
end;

function NtQueryDirectoryFileMem(const FileHandle, Event: THandle; ApcRoutine: Pointer; ApcContext: Pointer;
                                pIoBlock: PIO_STATUS_BLOCK; var pFileInfo: Pointer; var cbFileInfo: DWord;
                                const InfoClass: FILE_INFORMATION_CLASS; ReturnSingleEntry: LongBool;
                                FileName: PUNICODE_STRING; RestartScan: LongBool): NTSTATUS;
begin
Result := NtQueryDirectoryFile(FileHandle, Event, ApcRoutine, ApcContext, pIoBlock, pFileInfo,
                               cbFileInfo, InfoClass, ReturnSingleEntry, FileName, RestartScan);
while True do
 case Result of
  STATUS_BUFFER_OVERFLOW, STATUS_INFO_LENGTH_MISMATCH:
   begin
    if cbFileInfo > 0 then inc(cbFileInfo, cbFileInfo) else inc(cbFileInfo, QUERY_FILE_FS_INC);
    ReallocMem(pFileInfo, cbFileInfo);
    Result := NtQueryDirectoryFile(FileHandle, Event, ApcRoutine, ApcContext, pIoBlock, pFileInfo,
                                   cbFileInfo, InfoClass, ReturnSingleEntry,
                                   FileName, Result = STATUS_INFO_LENGTH_MISMATCH);

   end;
  STATUS_PENDING:
   begin
    Assert(False, 'NtQueryDirectoryFile   STATUS_PENDING');
    Exit;
   end;
  else Exit;
 end;
end;

function Nt_CreateFile(const pObjName: PUNICODE_STRING; const DesAccess: ACCESS_MASK; const pIoBlock: PIO_STATUS_BLOCK;
                      const pAllocSize: PLARGE_INTEGER; const FileAttr, ShareAccess, CreateDispos, CreateOptions: ULONG;
                      const pRootDir: PHandle; const pSecDecript: PSECURITY_DESCRIPTOR; var FileHandle: THandle): NTSTATUS;
var
ObjAttr: OBJECT_ATTRIBUTES;
begin
if pRootDir <> nil
 then InitializeObjectAttributes(@ObjAttr, pObjName, OBJ_CASE_INSENSITIVE, pRootDir^, pSecDecript)
 else InitializeObjectAttributes(@ObjAttr, pObjName, OBJ_CASE_INSENSITIVE, 0, pSecDecript);
Result := NtCreateFile(@FileHandle, DesAccess, @ObjAttr, pIoBlock, pAllocSize,
                       FileAttr, ShareAccess, CreateDispos, CreateOptions, nil, 0);
end;

const
WIDE_DBL_POINT_DWORD: LongWord    = 3014702; // PDWord(PWideChar(WIDE_DBL_POINT))^

function Us_IsNotEmptyOrRoot(const pName: PWideChar; const NameLen: LongWord): Boolean;
begin
case NameLen of
 0: Result := False;
 1: Result := pName[0] <> '.';
 2: Result := PLongWord(pName)^ <> WIDE_DBL_POINT_DWORD;
 else Result := True;
end;
end;


---

ZENsan   (2008-06-13 16:24:00) [6]

Я с головы пишу, поэтому приношу извинения что мой код далеко не идеальный и вы находите в нём недочёты. Логинов Дмитрий.
Именно поэтому я налету писал ChDir чтобы не думать там с этими слешами и ExcludeTrailingPathDelimiter...

---

ZENsan   (2008-06-13 15:46:00) [7]

> Хм... Наряду с этим примером странно слышать про Thread-
> safe...

А ты телепат, и знаешь все тонкости задачи. Это пример человеку, который спрашивал. Вам не годится - не юзайте. А кому надо изменит, что надо и пойдёт.

---

Amoeba   (2008-06-12 20:25:00) [8]

> ZENsan ©   (12.06.08 18:58) [11]
>
> >>И зачем так сложно? Проще использовать ShFileOperation:
>
> Она не всегда Thread-safe.

Как правило, это не актуально.

---

Loginov Dmitry.   (2008-06-12 19:48:00) [9]

> Она не всегда Thread-safe



> ChDir(Path);



> ChDir(ExtractFilePath(ParamStr(0)));


Хм... Наряду с этим примером странно слышать про Thread-safe...

---

ZENsan   (2008-06-12 18:58:00) [10]

>>И зачем так сложно? Проще использовать ShFileOperation:
Она не всегда Thread-safe. Конечно легче ShFileOperation.


procedure TUtils.EmptyFolder(const Path: String; Level: Integer = 0);
var
 Dir: TSearchRec;
begin
 if Level > 1 then
   Exit;
 if not DirectoryExists(Path) then
   Exit;
 try
   ChDir(Path);
   if FindFirst('*.*', $3F, Dir) = 0 then
     try
       repeat
         if (Dir.Name = '.') or (Dir.Name = '..') then
           Continue;
         if Dir.Attr and faDirectory = 0 then
           DeleteFile(Dir.Name)
         else
           begin
             EmptyFolder(ExcludeTrailingPathDelimiter(Path) + '\'  +
               Dir.Name + '\', Level + 1);
             RemoveDir(Dir.Name);
           end;
       until FindNext(Dir) <> 0;
     finally
       FindClose(Dir);
     end;
 finally
   ChDir(ExtractFilePath(ParamStr(0)));
 end;
end;


---

ZENsan   (2008-06-12 18:55:00) [11]

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

---

Anatoly Podgoretsky   (2008-06-12 13:19:00) [12]

> ну и FindClose.. как бы тоже дописать для моды :)

Кому мода, а кому нормальное написание программ. Модники обычно долго не живут.

---

Amoeba   (2008-06-12 12:46:00) [13]

И зачем так сложно? Проще использовать ShFileOperation:
http://www.delphikingdom.com/asp/viewitem.asp?catalogid=91

---

ZENsan   (2008-06-12 11:27:00) [14]

ну и FindClose.. как бы тоже дописать для моды :)

---

ZENsan   (2008-06-12 11:25:00) [15]

> 4) А не нарушит ли удаление файла в цикле логику findFirst/FindNext?
>  (я это не проверял, посколько всегда удаляю с использованием
> временного TStringList'a)


Не нарушит. Временный стринглист - это тоже лишнее.

Можно очистить ещё и так (если без ShFileOperation):

procedure TUtils.EmptyFolder(const Path: String; Level: Integer = 0);
var
 Dir: TSearchRec;
begin
 if Level > 1 then
   Exit;
 if not DirectoryExists(Path) then
   Exit;
 try
   ChDir(Path);
   if FindFirst('*.*', $3F, Dir) = 0 then
     repeat
       if (Dir.Name = '.') or (Dir.Name = '..') then
         Continue;
       if Dir.Attr and faDirectory = 0 then
         DeleteFile(Dir.Name)
       else
         begin
           EmptyFolder(ExcludeTrailingPathDelimiter(Path) + '\'  +
             Dir.Name + '\', Level + 1);
           RemoveDir(Dir.Name);
         end;
     until FindNext(Dir) <> 0;
 finally
   ChDir(ExtractFilePath(ParamStr(0)));
 end;
end;


---

Loginov Dmitry   (2008-06-12 10:37:00) [16]

> [1] savyhinst ©   (12.06.08 10:22)


1) А поиск закрывать ныне не модно?
2) Зачем PChar? Это лишнее копирование строки.
3) DeleteFile попытается удалить не только файлы.
4) А не нарушит ли удаление файла в цикле логику findFirst/FindNext? (я это не проверял, посколько всегда удаляю с использованием временного TStringList'a)

> а встроенной функции типа deleteFile нет?


В RxLib'е есть. Бери.

---

Anatoly Podgoretsky   (2008-06-12 10:36:00) [17]

> Yury  (12.06.2008 10:18:00)  [0]

Смотри справку по ShFileOperation

---

savyhinst   (2008-06-12 10:28:00) [18]

ХЗ, вроде бы нету

---

Yury   (2008-06-12 10:23:00) [19]

а встроенной функции типа deleteFile нет?

---

savyhinst   (2008-06-12 10:22:00) [20]

var
 sr:TSearchRec;
begin
 if findFirst('katalog\*.*',faAnyFile,sr)=0 then
 repeat
   if (sr.name<>'.')and(sr.name<>'..') then
     DeleteFile(PChar('katalog\'+sr.name);
 until FindNext(sr)<>0;
end;

---

Наверх