[RETO] Ruta más oculta

[Psyke1]

Pues eso, consiste en encontrar la manera más rápida de obtener la última carpeta accesible a partir de una ruta, los formatos válidos son estos:

Código (vb) [Seleccionar] Expandir

Public Function getLastFolder(Byval sStartPath As String) As String()
Public Function getLastFolder(Byval sStartPath As String) As Collection

Ejemplo:

Código (vb) [Seleccionar] Expandir


Debug.Print getLastFolder("C:\Users\casa-pc\Desktop\")


Código [Seleccionar] Expandir

C:\Users\casa-pc\Desktop\Música\Sonido\Programas\Video\VLC\data\res

Consiste en encontrar la carpeta más profunda, en caso de haber más de una la función devolverá el resultado en una collection o en un array.

¡Suerte!

[$Edu$]

Pero tu tienes otras carpetas ademas de Musica en el Desktop no? xD

Es decir, si tengo 20 carpetas, pero solo una de ellas tiene mas carpetas dentro, entonces esta ultima es la que hay que buscar su ultima carpeta no?

[Psyke1]

Claro, hay que sacar la ruta más profunda.

DoEvents!

[$Edu$]

No tengo instalado el VB6 pero queria pensarlo por lo menos. Si nadie contesta deja tu codigo que quiero verlo, se que tendras algo interesante xD

[seba123neo]

pues aca te pongo algo simple con Dir$, no creo que sea lo mas rapido, seguro alguna recursiva podra ser mas veloz, como con FSO, pero por lo menos cumple el objetivo.

Código (vb) [Seleccionar] Expandir

Option Explicit

Private Function CarpetaMasProfunda(ByVal pPath As String)

    Dim vCarpetas As New Collection
    Dim vNext As Integer
    Dim vDir As String
    Dim vSubDir As String
    Dim vResult As String
   
    vNext = 1
    vCarpetas.Add pPath
   
    Do While vNext <= vCarpetas.Count

        vDir = vCarpetas(vNext)
        vNext = vNext + 1
       
        vSubDir = Dir$(vDir & "\*", vbDirectory)
       
        Do While vSubDir <> ""

            If vSubDir <> "." And vSubDir <> ".." Then
                vSubDir = vDir & "\" & vSubDir
                On Error Resume Next
                If GetAttr(vSubDir) And vbDirectory Then vCarpetas.Add vSubDir
            End If
           
            vSubDir = Dir$(, vbDirectory)
        Loop
    Loop
   
    '---------------------------------------------------------------------

    vResult = ""
   
    Dim vArr() As String
    Dim vCont As Integer
    Dim i As Integer
   
    For i = 1 To vCarpetas.Count
   
        vArr = Split(vCarpetas(i), "\")
       
        If UBound(vArr) > vCont Then
            vCont = UBound(vArr)
            vResult = vCarpetas(i)
        End If
    Next i
   
    CarpetaMasProfunda = vResult
End Function

Private Sub Form_Load()
    MsgBox CarpetaMasProfunda("C:\Program Files")
End Sub

lo probe con una carpeta con 10 mil carpetas adentro y en unos 10 segundos me muestra el path mas largo.

saludos.

[MCKSys Argentina]

Tampoco tengo VB acá, pero se me ocurre hacer un comando dir, guardar el resultado en un txt y parsear lineas buscando la que tiene mas barras "\", osea, el path mas profundo.

El comando dir sería:

Código [Seleccionar] Expandir


dir * /ad /s /b > c:\lista.txt


donde "c:\lista.txt" sería el path completo al archivo donde se guardan los dirs.
Despues se abre, se recorre linea 1 a 1 y se devuelve la mas profunda (contando las barras invertidas "\")

Si hago tiempo subo code.

Saludos!

[Elemental Code]

Tampoco tengo VB acá, pero se me ocurre hacer un comando dir, guardar el resultado en un txt y parsear lineas buscando la que tiene mas barras "\", osea, el path mas profundo.

El comando dir sería:

Código [Seleccionar] Expandir


dir * /ad /s /b > c:\lista.txt


donde "c:\lista.txt" sería el path completo al archivo donde se guardan los dirs.
Despues se abre, se recorre linea 1 a 1 y se devuelve la mas profunda (contando las barras invertidas "\")

Si hago tiempo subo code.

Saludos!

Cometi el error de copypastear tu codigo en una CMD.

CUIDADO CON EL PESO DEL TXT!

[MCKSys Argentina]

Cometi el error de copypastear tu codigo en una CMD.
CUIDADO CON EL PESO DEL TXT!

Si, hice un par de pruebas mas y vi que puede obtenerse un archivo grande, aunque habría que hacer algunas comparativas para ver si el método conviene o no...

Ni bien tenga VB a mano, armo code y copio...

EDIT: Mi intento

Código (vb) [Seleccionar] Expandir


Option Explicit

Public Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Public Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long

Const sEmpty = ""
Const cMaxPath = 260
Const cmDbl = """"

Public Function getDeeperPath(Folder As String) As String
'Function does not check if Folder is a valid path name
'Folder must NOT end with backslash (\)

Dim tmpFilePath As String
Dim sComm As String
Dim taskId As Long
Dim sLine As String
Dim lDepth As Long
Dim mPaths() As String
Dim curDeeperFolder As String

tmpFilePath = GetTempFile

sComm = "cmd /c dir " + cmDbl + Folder + "\*" + cmDbl + " /ad /s /b > " + cmDbl + tmpFilePath + cmDbl

Err.Clear
On Error GoTo Hell

taskId = Shell(sComm, vbHide)

Do While FileLen(tmpFilePath) = 0
    DoEvents
Loop

lDepth = 0
curDeeperFolder = sEmpty
Open tmpFilePath For Input Access Read As #1
Do While Not EOF(1)
    Line Input #1, sLine
    If sLine <> sEmpty Then
        If InStr(1, sLine, "\") > 0 Then
            mPaths = Split(sLine, "\")
            If UBound(mPaths) > lDepth Then
                lDepth = UBound(mPaths)
                curDeeperFolder = sLine
            End If
        End If
    End If
Loop
Close #1
Kill tmpFilePath

getDeeperPath = curDeeperFolder
Exit Function
Hell:
    MsgBox "Error in getDeeperPath: " & Err.Description
End Function

Function GetTempDir() As String
Dim sRet As String, c As Long

sRet = String(cMaxPath, 0)
c = GetTempPath(cMaxPath, sRet)
'If c = 0 Then ApiRaise Err.LastDllError
GetTempDir = Left$(sRet, c)
End Function

Function GetTempFile(Optional Prefix As String, Optional PathName As String) As String
Dim sRet As String

If Prefix = sEmpty Then Prefix = sEmpty
If PathName = sEmpty Then PathName = GetTempDir
   
sRet = String(260, 0)
GetTempFileName PathName, Prefix, 0, sRet
'GetTempFile = GetFullPath(StrZToStr(sRet))
GetTempFile = StrZToStr(sRet)
End Function

' Strip junk at end from null-terminated string
Function StrZToStr(s As String) As String
    StrZToStr = Left$(s, lstrlen(s))
End Function


[Psyke1]

ATENCIÓN: He añadido un detalle en la explicación del reto.



La forma que se me había ocurrido es similar a la de seba123neo... Pero estoy convencido de que se puede hacer sin guardar todas las carpetas, se ahorraría muchísimo tiempo. Sigo pensando.

Cometi el error de copypastear tu codigo en una CMD.

CUIDADO CON EL PESO DEL TXT!

DoEvents!

[$Edu$]

Yo tenia algo pensado como BackTracking, se demoraria muchisimo pero el codigo seria mas corto que todos xD