27 de abril de 2015

Eliminar directorio y subdirectorios contenidos

Una solución efectiva, utilizando recursividad y funciones del API de Windows. Cortesía de Çetin Basöz
Set Date Dmy
Local ldFolder,lcBaseFolder,ix
Local Array aFolders[1]
lcBaseFolder = 'e:\Backup'
APIDeclarations()
For ix=1 To Adir(aFolders,Addbs(m.lcBaseFolder)+'*',"DRHS")
  ldFolder = Ctod(Transform(aFolders[m.ix,1], \@R 99/99/9999'))
  If !Empty(m.ldFolder) And m.ldFolder < Date()-1
    RemoveFolder(Addbs(m.lcBaseFolder)+aFolders[m.ix,1])
  Endif
Endfor

Function RemoveFolder(m.tcPath)
  GetSubdirs(m.tcPath,'DirList')
  Select Dirlist
  Local Array laFolders[Reccount()]
  Scan
    laFolders[Recno()] = dirname
  Endscan
  Use In 'DirList'
  Asort(laFolders,1,-1,1,1)
  For jx=1 To Alen(laFolders)
    RemoveSubFolder(laFolders[m.jx])
  Endfor
Endfunc

Function GetSubdirs
  Lparameters tcPath,tcCursorName
  Local ix
  Local Array laDirs[1]
  If !Used(m.tcCursorName)
    Create Cursor (m.tcCursorName) (dirname m)
  Endif
  Insert Into (m.tcCursorName) Values (Upper(m.tcPath))
  For ix = 1 To Adir(laDirs,Addbs(m.tcPath)+"*.*","DRHS")
    If laDirs[ix,1]#"." And "D"$laDirs[ix,5]
      GetSubdirs(Addbs(m.tcPath)+laDirs[ix,1],m.tcCursorName)
    Endif
  Endfor
Endfunc

Function RemoveSubFolder(tcPath)
  Local Array laFiles[1]
  Local ix
  For ix=1 To Adir(laFiles,Addbs(m.tcPath)+'*.*','HRS')
    setAttribs(Addbs(m.tcPath)+laFiles[m.ix,1])
  Endfor
  setAttribs(Addbs(m.tcPath))
  Erase (Addbs(m.tcPath)+'*.*')
  Rmdir (m.tcPath)
Endfunc

Function APIDeclarations
  Declare Integer SetFileAttributes In Win32API ;
    string @ lpFileName,  Integer dwFileAttributes
  Declare Integer GetFileAttributes In Win32API ;
    string @ lpFileName
Endfunc

Function setAttribs
  Lparameters tcFileName, tlReadOnly, tlHidden, tlSystem
  #Define FILE_ATTRIBUTE_READONLY    0x00000001
  #Define FILE_ATTRIBUTE_HIDDEN      0x00000002
  #Define FILE_ATTRIBUTE_SYSTEM      0x00000004
 Local lnNewAttr  lnNewAttr = Iif(m.tlReadOnly,FILE_ATTRIBUTE_READONLY,0)+;
    iif(m.tlHidden,FILE_ATTRIBUTE_HIDDEN,0)+;
    iif(m.tlSystem,FILE_ATTRIBUTE_SYSTEM,0)

  Return ( SetFileAttributes(@tcFileName, ;
    bitor(Bitand(GetFileAttributes(@tcFileName),0xFFFFFFF8),lnNewAttr)) = 1)
Endfunc
Çetin Basöz
MS Foxpro MVP, MCP

No hay comentarios. :

Publicar un comentario

Los comentarios son moderados, por lo que pueden demorar varias horas para su publicación.