Удаление непустого каталога

Пришло письмо от читателя:

Здравствуйте

Вот, понадобилась мне процедурка удаления непустого каталога. Нашел, не помню где. Включил в програму, работала, пока не стал использовать длинные имена каталогов (без пробелов, кстати). 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]

Содержание раздела