Apagar subpastas

Delphi

20/07/2011

Gostaria de uma rotina que apagasse somente subpastas, mas a que eu tenho apaga Pasta, SubPasta e Arquivos. Como eu faço para apagar somente as subpastas? Abaixo a que eu tenho: 
function TForm1.DeleteFolder(FolderName: String;
  LeaveFolder: Boolean): Boolean;
var
  r: TshFileOpStruct;
begin
  Result := False;
  if not DirectoryExists(FolderName) then
  Exit;
  if LeaveFolder then
  FolderName := FolderName + ' *.* '
  else
  if FolderName[Length(FolderName)] = ' \ ' then
  Delete(FolderName,Length(FolderName), 1);
  FillChar(r, SizeOf(r), 0);
  r.wFunc := FO_DELETE;
  r.pFrom := PChar(FolderName);
  r.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION;
  Result := ((ShFileOperation(r) = 0) and (not r.fAnyOperationsAborted));
end;
Pjava

Pjava

Curtidas 0

Respostas

Adriano Bollas

Adriano Bollas

20/07/2011

Apagar um subdiretórioInclua a unit SHELLAPI na clausula uses do seu form.   procedure DeleteDir( hHandle : THandle; Const sPath : String );var OpStruc: TSHFileOpStruct; FromBuffer, ToBuffer: Array[0..128] of Char;
begin  fillChar( OpStruc, Sizeof(OpStruc), 0 );
 FillChar( FromBuffer, Sizeof(FromBuffer), 0 );
 FillChar( ToBuffer, Sizeof(ToBuffer), 0 );  StrPCopy( FromBuffer, sPath);  With OpStruc Do  Begin   Wnd:= hHandle;   wFunc:=FO_DELETE;   pFrom:= @FromBuffer;   pTo:= @ToBuffer;   fFlags:= FOF_NOCONFIRMATION;   fAnyOperationsAborted:=False;   hNameMappings:=nil;   //lpszProgressTitle:=nil;  End;  ShFileOperation(OpStruc); end;   Utilize a função assim:   procedure TForm1.Button1Click(Sender: TObject); begin   DeleteDir( Self.Handle,'C:\TESTE'); end;
Já testei e deu tudo certo. Espero que tenha ajudado.
GOSTEI 0
POSTAR