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

Вниз

очистка каталога   Найти похожие ветки 

← →
Yury   (2008-06-12 10:18) [0]

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

---

← →
savyhinst ©   (2008-06-12 10:22) [1]

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;

---

← →
Yury   (2008-06-12 10:23) [2]

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

---

← →
savyhinst ©   (2008-06-12 10:28) [3]

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

---

← →
Anatoly Podgoretsky ©   (2008-06-12 10:36) [4]

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

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

---

← →
Loginov Dmitry ©   (2008-06-12 10:37) [5]

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


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

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


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

---

← →
ZENsan ©   (2008-06-12 11:25) [6]

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


---

← →
ZENsan ©   (2008-06-12 11:27) [7]

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

---

← →
Amoeba ©   (2008-06-12 12:46) [8]

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

---

← →
Anatoly Podgoretsky ©   (2008-06-12 13:19) [9]

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

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

---

← →
ZENsan ©   (2008-06-12 18:55) [10]

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

---

← →
ZENsan ©   (2008-06-12 18:58) [11]

>>И зачем так сложно? Проще использовать 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;


---

← →
Loginov Dmitry.   (2008-06-12 19:48) [12]

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



> ChDir(Path);



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


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

---

← →
Amoeba ©   (2008-06-12 20:25) [13]

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

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

---

← →
ZENsan ©   (2008-06-13 15:46) [14]

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

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

---

← →
ZENsan ©   (2008-06-13 16:24) [15]

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

---

← →
Riply ©   (2008-06-13 17:24) [16]

Написала для себя небольшую процедуру удаления директории.
Да вот все руки не доходят погонять и потестировать ее по полной программе,
дабы пометить как готовую к употреблению и забыть :)
Чем черт не шутит, может и найдутся желающие выполнить за лентяку ее работу :)
Предупреждаю сразу о паре скользких моментов:
нет проверки на 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;


---

← →
Riply ©   (2008-06-13 17:25) [17]

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

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:28) [18]

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

---

← →
Игорь Шевченко ©   (2008-06-13 18:11) [19]

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

---

← →
Riply ©   (2008-06-13 18:18) [20]

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

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

---

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

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

Наверх

Память: 0.53 MB
Время: 0.033 c