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

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

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

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