Удаление непустого каталога
Пришло письмо от читателя:
Здравствуйте
Вот, понадобилась мне процедурка удаления непустого каталога. Нашел, не помню где. Включил в програму, работала, пока не стал использовать длинные имена каталогов (без пробелов, кстати). NT стала операцию выполнять, но криво (возбуждала исключение). Окончательно:
|
procedure TForm1.deletedirectory(dir:string); var sh:SHFILEOPSTRUCT; st:string; sr:tsearchrec; pst:pchar; begin if findfirst(dir,faDirectory,sr)=0 then begin //added by me dir:=longtoshortfilename(dir); //original code sh.Wnd:= Form1.handle; sh.wFunc:= FO_DELETE; Pst:=StrAlloc(Length(dir{sr.Name})+1); StrPLCopy(Pst,dir{sr.Name},Length(dir{sr.Name})+1); sh.pFrom:=pst; sh.pTo:= Nil; sh.fFlags:= FOF_NOCONFIRMATION or FOF_SILENT; sh.hNameMappings:= Nil; sh.lpszProgressTitle:= Nil; SHFileOperation(sh); StrDispose(Pst); end; findclose(sr); end; |
С уважением, Александр Рабцевич [000744]
