DIRTREE Arbol de solo Directorios

DIRTREE Arbol de solo Directorios

Postby cuatecatl82 » Sat Aug 03, 2013 2:55 am

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)
Soluciones y Diseño de Software
Damos Soluciones...

I.S.C. Victor Daniel Cuatecatl Leon
Director y Diseñador de Proyectos

http://www.soldisoft.unlugar.com
http://www.sisa.unlugar.com
danyleon82@hotmail.com
www.facebook.com/victordaniel.cuatecatlleon
User avatar
cuatecatl82
 
Posts: 625
Joined: Wed Mar 14, 2007 6:49 pm
Location: San Cristobal de las Casas, Chiapas México

Re: DIRTREE Arbol de solo Directorios

Postby Antonio Linares » Sat Aug 03, 2013 6:35 am

Victor,

No te sirve esto ?

MsgInfo( cGetDir() )
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 41319
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: DIRTREE Arbol de solo Directorios

Postby cuatecatl82 » Sat Aug 03, 2013 12:41 pm

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
Soluciones y Diseño de Software
Damos Soluciones...

I.S.C. Victor Daniel Cuatecatl Leon
Director y Diseñador de Proyectos

http://www.soldisoft.unlugar.com
http://www.sisa.unlugar.com
danyleon82@hotmail.com
www.facebook.com/victordaniel.cuatecatlleon
User avatar
cuatecatl82
 
Posts: 625
Joined: Wed Mar 14, 2007 6:49 pm
Location: San Cristobal de las Casas, Chiapas México

Re: DIRTREE Arbol de solo Directorios

Postby acuellar » Wed Aug 07, 2013 7:25 pm

Antonio con cGetDir() se puede empezar a mostrar desde una carpeta especifica
Ej: MsgInfo(cGetDir("D:\SISTEMAS"))

Gracias.

Saludos,

Adhemar
Saludos,

Adhemar C.
User avatar
acuellar
 
Posts: 1593
Joined: Tue Oct 28, 2008 6:26 pm
Location: Santa Cruz-Bolivia


Return to FiveWin para Harbour/xHarbour

Who is online

Users browsing this forum: No registered users and 9 guests