Mi_Dir Ejemplo de Directorio con Subcarpetas

  • Archivo: Mi_Dir.prg 
***Creado por Jose Miguel (Valencia)***
***Mi_Dir Version 0.1***
/*Dado que no he encontrado un comando apropiado y
* despues de mucho pelear con el codigo, he construido
* una funcion que lo si lo hace.
* Funciona igual que DIRECTORY y devuelme los mismos
* parametros, en el nombre incluye las subcarpetas.
*
* ejemplo:
* aDir:=Mi_Dir('c:\programa','*.dbf')
* aDir[1,1]='base1.dbf'
* aDir[2,1]='base2.dbf'
* aDir[3,1]='subdir\base1.dbf'
* aDir[4,1]='subdir\subdir\base1.dbf'
*
* Espero que les sea de utilidad
*/

#include "minigui.ch"

PROCEDURE main()
/*
   ***CODIGO DE PAGINA español***
*   REQUEST HB_CODEPAGE_ESWIN
   HB_SETCODEPAGE("ESWIN")
   SET LANGUAGE TO SPANISH //Select language for interface messages

   ***Inicializacion RDD DBFCDX Nativo***
   REQUEST DBFCDX , DBFFPT
   RDDSETDEFAULT( "DBFCDX" )
*/
   Set Navigation Extended //TAB y ENTER
   SET DATE FORMAT "dd-mm-yyyy"
   SET EPOCH TO YEAR(DATE())-50

   DEFINE WINDOW Ventana1 ;
      AT 0,0 ;
      WIDTH 800 ;
      HEIGHT 600 ;
      TITLE "Programa de aplicaciones" ;
      MAIN

      @015,010 LABEL L_Ruta1 VALUE 'Ruta:' AUTOSIZE TRANSPARENT
      @010,100 TEXTBOX T_Ruta1 ;
         WIDTH 685 ;
         VALUE GetCurrentFolder() ;
         TOOLTIP 'Ruta a buscar' ;
         NOTABSTOP
      @040,100 BUTTON Bt_Buscardir1 ;
         CAPTION 'Buscar direcctorio' ;
         WIDTH 175 HEIGHT 25 ;
         ACTION Ventana1.T_Ruta1.Value:= GetFolder("Carpetas",Ventana1.T_Ruta1.Value) ;
         NOTABSTOP

      @075,010 LABEL L_Extension VALUE 'Extension:' AUTOSIZE TRANSPARENT
      @070,100 TEXTBOX T_Extension ;
         WIDTH 100 ;
         VALUE '*.*' ;
         TOOLTIP 'Ruta a buscar' ;
         NOTABSTOP

      @070,300 BUTTON Bt_Buscarfic1 ;
         CAPTION 'Buscar ficheros' ;
         WIDTH 175 HEIGHT 25 ;
         ACTION llenarBR_Fic() ;
         NOTABSTOP

      @075,600 LABEL L_Total VALUE 'Total ficheros:' AUTOSIZE TRANSPARENT


      @100,010 GRID BR_Fic ;
      HEIGHT 400 ;
      WIDTH 750 ;
      TOOLTIP 'ficheros' ;
      HEADERS {'Fichero','Tamaño','Fecha','Hora','Atributos'} ;
      WIDTHS {400,100,80,70,70 } ;
      ITEMS DIRECTORY(Ventana1.T_Ruta1.Value) ;
      JUSTIFY {BROWSE_JTFY_LEFT,BROWSE_JTFY_RIGHT,BROWSE_JTFY_CENTER,BROWSE_JTFY_CENTER,BROWSE_JTFY_CENTER} ;
      VALUE 1

   END WINDOW
   CENTER WINDOW Ventana1
   ACTIVATE WINDOW Ventana1
RETURN NIL

Static Function llenarBR_Fic()
   LOCAL aMIDIR:=Mi_Dir(Ventana1.T_Ruta1.Value,Ventana1.T_Extension.Value),N
   Ventana1.BR_Fic.DeleteAllItems
   Ventana1.L_Total.Value:='Total ficheros: '+LTRIM(STR(LEN(aMIDIR)))
   IF LEN(aMIDIR)>0
      
      FOR N=1 TO LEN(aMIDIR)
         Ventana1.BR_Fic.AddItem({aMIDIR[N,1],STR(aMIDIR[N,2]),DTOC(aMIDIR[N,3]),aMIDIR[N,4],aMIDIR[N,5]})
      NEXT
      
   ENDIF
   Ventana1.BR_Fic.Refresh
RETURN NIL


Function Mi_Dir(Mi_Dir1,Mi_Fic1)
   LOCAL aDir1,aDir2,aDir3,NIVEL,N1,N2
   Mi_Dir1 := IF(RIGHT(Mi_Dir1,1)=='\',LEFT(Mi_Dir1,LEN(Mi_Dir1)-1),Mi_Dir1)
   aDir1:=Mi_Dir2(Mi_Dir1,Mi_Fic1)
   aDir2:={}
   aDir3:={}
   NIVEL:=0

   FOR N1=1 TO LEN(aDir1)
      IF aDir1[N1,1]="."
         LOOP
      ENDIF
      IF aDir1[N1,5]="D"
         DO EVENTS
         NIVEL++
         IF NIVEL=1
            aDir2:={{aDir1[N1,1],N1}}
         ELSE
            IF NIVEL>LEN(aDir2)
               AADD(aDir2, {aDir1[N1,1],N1} )
            ELSE
               aDir2[NIVEL]:={aDir1[N1,1],N1}
            ENDIF
         ENDIF
         FOR N2=1 TO LEN(aDir2)
            IF N2=1
               aDir4:=aDir2[N2,1]
            ELSE
               aDir4:=aDir4+"\"+aDir2[N2,1]
            ENDIF
            IF N2=NIVEL
               EXIT
            ENDIF
         NEXT
         aDir1:=Mi_Dir2(Mi_Dir1+"\"+aDir4,Mi_Fic1)
         N1:=0
      ELSE
         IF NIVEL=0
            AADD(aDir3,{aDir1[N1,1],aDir1[N1,2],aDir1[N1,3],aDir1[N1,4],aDir1[N1,5]})
         ELSE
            AADD(aDir3,{aDir4+"\"+aDir1[N1,1],aDir1[N1,2],aDir1[N1,3],aDir1[N1,4],aDir1[N1,5]})
         ENDIF
      ENDIF

      IF N1>=LEN(aDir1) .AND. NIVEL>0
         DO WHILE .T.
            IF NIVEL=1
               aDir1:=Mi_Dir2(Mi_Dir1,Mi_Fic1)
               N1:=aDir2[NIVEL,2]
               NIVEL--
            ELSE
               FOR N2=1 TO LEN(aDir2)
                  IF N2=1
                     aDir4:=aDir2[N2,1]
                  ELSE
                     aDir4:=aDir4+"\"+aDir2[N2,1]
                  ENDIF
                  IF N2=NIVEL-1
                     EXIT
                  ENDIF
               NEXT
               aDir1:=Mi_Dir2(Mi_Dir1+"\"+aDir4,Mi_Fic1)
               N1:=aDir2[NIVEL,2]
               NIVEL--
            ENDIF
            IF N1>=LEN(aDir1) .AND. NIVEL>0
               LOOP
            ELSE
               EXIT
            ENDIF
         ENDDO
      ENDIF
   NEXT
RETURN(aDir3)

STATIC Function Mi_Dir2(Mi_Dir2,Mi_Fic1)
   LOCAL aDirT1:={},NT2
   LOCAL aDirT2:=Directory(Mi_Dir2+"\*.*","D")
   ASORT( aDirT2,,, {| x, y | UPPER(x[1]) < UPPER(y[1]) } )
   FOR NT2=1 TO LEN(aDirT2)
      IF aDirT2[NT2,5]="D" .AND. aDirT2[NT2,1]<>"."
         AADD(aDirT1,aDirT2[NT2])
      ENDIF
   NEXT
   aDirT2:=Directory(Mi_Dir2+"\"+Mi_Fic1)
   ASORT( aDirT2,,, {| x, y | UPPER(x[1]) < UPPER(y[1]) } )
   FOR NT2=1 TO LEN(aDirT2)
      AADD(aDirT1,aDirT2[NT2])
   NEXT
RETURN(aDirT1)