FiveTech Software tech support forums

www.FiveTechSoft.com
https://forums.fivetechsupport.com/

DIRTREE Arbol de solo Directorios

https://forums.fivetechsupport.com/viewtopic.php?f=6&t=26898

Page 1 of 1

DIRTREE Arbol de solo Directorios

PostPosted: Sat Aug 03, 2013 2:55 am
by cuatecatl82
Pues eso, necesitaba una función que me permitiera tener en una DBF un Arbol de solo Directorios o DIRTREE, con DirectoryRecurse() obtenemos todos los archivos y solo carpetas que contiene archivos, Directory() obtiene todos los archivos y directorios, con o sin archivos, pero para poder acceder a todas las ramas del disco habia que hacer mucho codigo.

No se si alguien tenga el código mejorado, pero para mis necesidades me es suficiente, ya que busque en el foro y no encontre me dedique unas horas a hacer pruebas y se las comparto:

Code: Select all  Expand view
#INCLUDE "DIRECTRY.CH"

STATIC aTree:= {}

#IfNDef __XHARBOUR__
FUNCTION DbSkipper( n ) ; RETURN __DbSkipper( n )
FUNCTION DBPACK() ; RETURN __DbPack()
FUNCTION DBZAP() ; RETURN hb_DBZap()
FUNCTION CurDrive( x ) ; RETURN hb_CurDrive( x )
#EndIf

FUNCTION Main()

ArbolDir("C:\WINDOWS\Help") //Puede ser "C:" o un directorio: "C:\Windows"

RETURN Nil




//------------------------------------------------------------------------------------------------------------------//
STATIC FUNCTION ArbolDir(cDir)

LOCAL cletra:= UPPER(cDir)
LOCAL  aDirs:= DirTree(cletra)
LOCAL N

IF LEN(aDirs) > 0
  FOR N:= 1 TO LEN(aDirs)
    MSGInfo("Direcorio: " + aDirs[N],"Origen: "+ cFilePath(aDirs[N]))
  NEXT
 MSGInfo(ALLTRIM(STR(LEN(aDirs)))+" Carpetas Encontrados", "DIRTREE")
ELSE
 MSGStop("Disco "+cletra+" no Válido o Vacio", "DIRTREE")
ENDIF

RETURN Nil




//------------------------------------------------------------------------------------------------------------------//
STATIC FUNCTION DirTree(cDir)

LOCAL aSubDirs,nLen,i

aSubDirs:= GetTreeSubDirs(DIRECTORY(cDir+"\*.*","D"),cDir)
    nLen:= LEN(aSubDirs)

IF nLen > 0
   FOR I:= 1 TO nLen
      AADD(aTree,aSubDirs[I])
      CURDRIVE(LEFT(aSubDirs[I],1))
      CURDIR(aSubDirs[I])
      DirTree(aSubDirs[I])
   NEXT
ENDIF


RETURN aTree




//------------------------------------------------------------------------------------------------------------------//
STATIC FUNCTION GetTreeSubDirs(aDirs,cDir)

LOCAL N
LOCAL    nLen:= LEN(aDirs)
LOCAL aDirVal:= {}

IF nLen > 0
   FOR N:= 1 TO nLen
      IF AT("D",aDirs[N,F_ATTR]) > 0 .AND. LEFT(aDirs[N,F_NAME],1)#"."
         AADD(aDirVal,cDir+"\"+aDirs[N,F_NAME])
      ENDIF
   NEXT
ENDIF

RETURN aDirVal


Optimizaciones, opiniones y/o mejoras son bienvenidas.. :lol: :lol: :lol: 8)

Re: DIRTREE Arbol de solo Directorios

PostPosted: Sat Aug 03, 2013 6:35 am
by Antonio Linares
Victor,

No te sirve esto ?

MsgInfo( cGetDir() )

Re: DIRTREE Arbol de solo Directorios

PostPosted: Sat Aug 03, 2013 12:41 pm
by cuatecatl82
Maestro Antonio:

La función cGetDir() me sirve para buscar un directorio, pero necesitaba para un proyecto tener en un aray o una dbf solo los directorios de todo un disco o carpeta, he agregado unas cosas más, ahora retorna el Nombre de la Carpeta, la ruta de Origen, el tamaño, la hora de creación y atributos, tal y como lo hace Directory()

Cabe mencionar que Directory() no devuelve el tamaño de las carpetas, aqui le agrege unas lineas más para que puedacalcularlo:

Comentario y criticas con bienvenidas...

Code: Select all  Expand view
#INCLUDE "fivewin.CH"
#INCLUDE "DIRECTRY.CH"

STATIC aTree:= {}

#IfNDef __XHARBOUR__
FUNCTION DbSkipper( n ) ; RETURN __DbSkipper( n )
FUNCTION DBPACK() ; RETURN __DbPack()
FUNCTION DBZAP() ; RETURN hb_DBZap()
FUNCTION CurDrive( x ) ; RETURN hb_CurDrive( x )
#EndIf

# Define  cPicture       "@E 9,999,999,999,999.99"  // Picture para mostar números con decimales
# Define  cPictInt       "@E 9,999,999,999,999,999" // Picture para mostar números sin decimales


FUNCTION main()
  ArbolDir("D:")
RETURN Nil

FUNCTION ArbolDir(cDir)

LOCAL cletra:= UPPER(cDir)
LOCAL  aDirs:= DirTree(cletra)
LOCAL N

IF LEN(aDirs) > 0
  FOR N:= 1 TO LEN(aDirs)
    MSGStop("Direcorio: " + aDirs[N,1] +CRLF+;
            "Origen: " + aDirs[N,2] +CRLF+;
            "Tamaño: " + aDirs[N,3] +CRLF+;
            "Creado: " + cValtoChar(aDirs[N,4]) +CRLF+;
            "Hora: " + aDirs[N,5] +CRLF+;
            "Atributos: " + aDirs[N,6]+"","TREEDIR")
  NEXT
 MSGInfo(ALLTRIM(STR(LEN(aDirs)))+" Carpetas Encontrados", "DIRTREE")
ELSE
 MSGStop("Disco "+cletra+" no Válido o Vacio", "DIRTREE")
ENDIF

RETURN Nil




//------------------------------------------------------------------------------------------------------------------//
STATIC FUNCTION DirTree(cDir)

LOCAL aSubDirs,nLen,i

aSubDirs:= GetTreeSubDirs(DIRECTORY(cDir+"\*.*","D"),cDir)
    nLen:= LEN(aSubDirs)

IF nLen > 0
   FOR I:= 1 TO nLen
      AADD(aTree,{aSubDirs[I,1],aSubDirs[I,2],aSubDirs[I,3],aSubDirs[I,4],aSubDirs[I,5],aSubDirs[I,6]})
      CURDRIVE(LEFT(aSubDirs[I,1],1))
      CURDIR(aSubDirs[I,1])
      DirTree(aSubDirs[I,1])
   NEXT
ENDIF


RETURN aTree




//------------------------------------------------------------------------------------------------------------------//
STATIC FUNCTION GetTreeSubDirs(aDirs,cDir)

LOCAL N
LOCAL    nLen:= LEN(aDirs)
LOCAL aDirVal:= {}

IF nLen > 0
   FOR N:= 1 TO nLen
      IF AT("D",aDirs[N,F_ATTR]) > 0 .AND. LEFT(aDirs[N,F_NAME],1)#"."
         AADD(aDirVal,{cDir + "\" + aDirs[N,F_NAME], cFilePath(cDir + "\" + aDirs[N,F_NAME]), Espacio(cDir + "\" + aDirs[N,F_NAME]), aDirs[N,F_DATE], aDirs[N,F_TIME], aDirs[N,F_ATTR]})
      ENDIF
   NEXT
ENDIF

RETURN aDirVal




//------------------------------------------------------------------------------------------------------------------//
STATIC FUNCTION Espacio(cDir)

LOCAL cSize, N
LOCAL nSize:= 0
LOCAL ADirs:= DIRECTORY(cDir+"\*.*",'DHS')
LOCAL nFound:= LEN(ADirs)

IF nFound > 0
   FOR N:= 1 TO nFound
     nSize:= nSize + ADirs[N,F_SIZE]
   NEXT
   cSize:= fFormat(nSize,.T.)
ELSE
   cSize:= "Vacio"
ENDIF


RETURN cSize




//------------------------------------------------------------------------------------------------------------------//
STATIC FUNCTION fFormat( nValue, lShortFormat)

LOCAL cTmp := " Bytes"
LOCAL nBT, nKB, nMB, nGB, nTB, nPB


  nBT := 1024
  nKB := nBT * nBT
  nMB := nKB * nBT
  nGB := nMB * nBT
  nTB := nGB * nBT
  nPB := nTB * nBT

  IF lShortFormat

     DO CASE
        CASE nValue < nKB
             cTmp   := " Bytes"

        CASE nValue > nBT .AND. nValue < nKB

             cTmp   := " KB"
             nValue := nValue / nBT

        CASE nValue > nKB .AND. nValue < nMB

             cTmp   := " MB"
             nValue := nValue / nKB

        CASE nValue > nMB .AND. nValue < nGB

             cTmp   := " GB"
             nValue := nValue / nMB

        CASE nValue > nGB .AND. nValue < nTB

             cTmp   := " TB"
             nValue := nValue / nGB

        CASE nValue > nTB .AND. nValue < nPB

             cTmp   := " PB"
             nValue := nValue / nTB

        OTHERWISE

             cTmp   := " N/D"
             nValue := nValue / ( nPB * nPB )

     ENDCASE

  ENDIF

RETURN fPicture( nValue ) + cTmp




//------------------------------------------------------------------------------------------------------------------//
STATIC FUNCTION fPicture( nValue )

  LOCAL cValue

  IF "." $ STR( nValue ) // Verifica si el número tienes decimales

     cValue := LTRIM( TRANSFORM( nValue, cPicture ) )

  ELSE

     cValue := LTRIM( TRANSFORM( nValue, cPictInt ) )

  ENDIF

RETURN cValue



Solo basta con llamarlo así:
Code: Select all  Expand view
ArbolDir("D:")
prueben con carpetas vacias y con archivos, espero les sirva en alguna ocación.

Saludos

Re: DIRTREE Arbol de solo Directorios

PostPosted: Wed Aug 07, 2013 7:25 pm
by acuellar
Antonio con cGetDir() se puede empezar a mostrar desde una carpeta especifica
Ej: MsgInfo(cGetDir("D:\SISTEMAS"))

Gracias.

Saludos,

Adhemar
All times are UTC
Page 1 of 1
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
http://www.phpbb.com/