Título: [RETO] Ruta más oculta
Publicado por: Psyke1 en 11 Enero 2013, 12:14 pm
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: Public Function getLastFolder(Byval sStartPath As String) As String() Public Function getLastFolder(Byval sStartPath As String) As Collection
Ejemplo: Debug.Print getLastFolder("C:\Users\casa-pc\Desktop\")
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! :)
Título: Re: [RETO] Ruta más oculta
Publicado por: $Edu$ en 11 Enero 2013, 17:19 pm
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?
Título: Re: [RETO] Ruta más oculta
Publicado por: Psyke1 en 11 Enero 2013, 18:30 pm
Claro, hay que sacar la ruta más profunda. ;)
DoEvents! :P
Título: Re: [RETO] Ruta más oculta
Publicado por: $Edu$ en 11 Enero 2013, 21:22 pm
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
Título: Re: [RETO] Ruta más oculta
Publicado por: seba123neo en 11 Enero 2013, 21:30 pm
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. 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.
Título: Re: [RETO] Ruta más oculta
Publicado por: MCKSys Argentina en 11 Enero 2013, 23:53 pm
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: 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!
Título: Re: [RETO] Ruta más oculta
Publicado por: Elemental Code en 12 Enero 2013, 00:41 am
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: 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!
Título: Re: [RETO] Ruta más oculta
Publicado por: MCKSys Argentina en 12 Enero 2013, 04:24 am
Cometi el error de copypastear tu codigo en una CMD. CUIDADO CON EL PESO DEL TXT!
:xD 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 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
Título: Re: [RETO] Ruta más oculta
Publicado por: Psyke1 en 12 Enero 2013, 10:42 am
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. :rolleyes: Cometi el error de copypastear tu codigo en una CMD.
CUIDADO CON EL PESO DEL TXT!
(http://www.computerandyou.net/wp-content/uploads/2012/11/You-have-been-hacked.jpg) :laugh: DoEvents! :P
Título: Re: [RETO] Ruta más oculta
Publicado por: $Edu$ en 12 Enero 2013, 14:00 pm
Yo tenia algo pensado como BackTracking, se demoraria muchisimo pero el codigo seria mas corto que todos xD
Título: Re: [RETO] Ruta más oculta
Publicado por: LeandroA en 12 Enero 2013, 20:53 pm
Ojo dependiendo el método la función puede ser mas rápida la segunda vez que se ejecuta, por lo tanto debe medirse en varios bucles. esta es la mia Option Explicit Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long Private Const MAX_PATH As Long = 260 Private Const INVALID_HANDLE_VALUE As Long = -1 Private Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Private Type WIN32_FIND_DATA dwFileAttributes As Long ftCreationTime As FILETIME ftLastAccessTime As FILETIME ftLastWriteTime As FILETIME nFileSizeHigh As Long nFileSizeLow As Long dwReserved0 As Long dwReserved1 As Long cFileName As String * MAX_PATH cAlternate As String * 14 End Type Private c_cFolders As Collection Private m_Max As Long Public Function GetLastFolder(ByVal sStartPath As String) As Collection m_Max = 0 Set c_cFolders = New Collection sStartPath = IIf(Right$(sStartPath, 1) = "\", sStartPath, sStartPath & "\") pvFindFolders sStartPath, 0 Set GetLastFolder = c_cFolders End Function Private Sub pvFindFolders(sPath As String, lMax As Long) Dim lRet As Long Dim lhSearch As Long Dim tWFD As WIN32_FIND_DATA Dim svDirs() As String Dim lCount As Long Dim sDir As String Dim i As Long Dim sFolder As String lhSearch = FindFirstFile(sPath & "*", tWFD) If Not lhSearch = INVALID_HANDLE_VALUE Then Do If (tWFD.dwFileAttributes And vbDirectory) = vbDirectory Then sFolder = Left$(tWFD.cFileName, lstrlen(tWFD.cFileName)) If InStrB(sFolder, ".") <> 1 Then sDir = sPath & sFolder ReDim Preserve svDirs(lCount) svDirs(lCount) = sDir & "\" lCount = lCount + 1 If lMax > m_Max Then m_Max = lMax Set c_cFolders = New Collection Call c_cFolders.Add(sDir) ElseIf lMax = m_Max Then Call c_cFolders.Add(sDir) End If End If End If lRet = FindNextFile(lhSearch, tWFD) Loop While lRet Call FindClose(lhSearch) For i = 0 To lCount - 1 Call pvFindFolders(svDirs(i), lMax + 1) Next End If End Sub
Option Explicit Private Sub Form_Load() Dim cColl As Collection Dim i As Long Set cColl = GetLastFolder("C:\Users\Windows\") For i = 1 To cColl.Count Debug.Print cColl(i) Next End Sub
Título: Re: [RETO] Ruta más oculta
Publicado por: seba123neo en 12 Enero 2013, 20:54 pm
aca va otra forma, igual a la que usa Dir$ que puse antes, pero esta es recursiva y usa apis, lo cual es muchisimo mas rapida. la anterior funcion me tarda 7 segundos en escanear la carpeta de program files de mi pc (que tiene 7 mil carpetas), esta solo tarda 1 segundo y a veces menos :xD. Option Explicit Private Const vbDot = 46 Private Const MAXDWORD As Long = &HFFFFFFFF Private Const MAX_PATH As Long = 260 Private Const INVALID_HANDLE_VALUE = -1 Private Const FILE_ATTRIBUTE_DIRECTORY = &H10 Private Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Private Type WIN32_FIND_DATA dwFileAttributes As Long ftCreationTime As FILETIME ftLastAccessTime As FILETIME ftLastWriteTime As FILETIME nFileSizeHigh As Long nFileSizeLow As Long dwReserved0 As Long dwReserved1 As Long cFileName As String * MAX_PATH cAlternate As String * 14 End Type Private Type FILE_PARAMS bRecurse As Boolean sFileRoot As String sFileNameExt As String sResult As String sMatches As String Count As Long End Type Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long Dim vCarpetas As New Collection Private Sub Command1_Click() Call CarpetaMasProfunda("c:\program files (x86)") Dim vResult As String 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 MsgBox vResult End Sub Private Sub CarpetaMasProfunda(ByVal pPath As String) Dim FP As FILE_PARAMS With FP .sFileRoot = pPath .sFileNameExt = "*.*" .bRecurse = 1 End With Dim WFD As WIN32_FIND_DATA Dim hFile As Long Dim sRoot As String Dim spath As String Dim sTmp As String sRoot = QualifyPath(FP.sFileRoot) spath = sRoot & FP.sFileNameExt hFile = FindFirstFile(spath, WFD) If hFile <> INVALID_HANDLE_VALUE Then Do If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) And Asc(WFD.cFileName) <> vbDot Then sTmp = TrimNull(WFD.cFileName) FP.Count = FP.Count + 1 vCarpetas.Add sRoot & sTmp If FP.bRecurse Then FP.sFileRoot = sRoot & sTmp Call CarpetaMasProfunda(FP.sFileRoot) End If End If Loop While FindNextFile(hFile, WFD) hFile = FindClose(hFile) End If End Sub Private Function TrimNull(pStart As String) As String Dim vPos As Integer vPos = InStr(pStart, Chr$(0)) If vPos Then TrimNull = Left$(pStart, vPos - 1) Exit Function End If TrimNull = pStart End Function Private Function QualifyPath(pPath As String) As String If Right$(pPath, 1) <> "\" Then QualifyPath = pPath & "\" Else QualifyPath = pPath End If End Function
saludos.
Título: Re: [RETO] Ruta más oculta
Publicado por: Karcrack en 14 Enero 2013, 21:59 pm
Para aumentar la velocidad deberíais llamar a FindFirstFileEx() usando estos flags: hFind = FindFirstFileEx(path, FindExInfoBasic, pCurrent, FindExSearchLimitToDirectories, NULL, FIND_FIRST_EX_LARGE_FETCH);
Aunque FindExInfoBasic y FIND_FIRST_EX_LARGE_FETCH sólo sirven de W$>Vista aumentarán mucho la velocidad en llamadas recurrentes. Y con FindExSearchLimitToDirectories también aunque tiene que ser cierta versión de NTFS... Yo hice una vez algo similar en C++ pero no he conseguido encontrar el código :laugh:
Título: Re: [RETO] Ruta más oculta
Publicado por: BlackZeroX en 14 Enero 2013, 22:26 pm
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.
Creo que querías decir iterativa, la recursividad es lenta... A reinstalar VB6 canijo!¡. Dulces Lunas!¡.
Título: Re: [RETO] Ruta más oculta
Publicado por: LeandroA en 15 Enero 2013, 01:57 am
Si es verdad FindFirstFileEx es un poco mas rapida, almenos vajo W7 o W8 aqui para que prueben, la diferencia se nota si utilizan las flags FindExInfoBasic o FindExInfoStandard, la primera hace que la funcion no rellene cAlternate de la extructura WIN32_FIND_DATA, con lo cual hace que sea has rapida. Option Explicit Private Declare Function FindFirstFileEx Lib "kernel32.dll" Alias "FindFirstFileExA" (ByVal lpFileName As String, ByVal fInfoLevelId As FINDEX_INFO_LEVELS, lpFindFileData As WIN32_FIND_DATA, ByVal fSearchOp As FINDEX_SEARCH_OPS, ByRef lpSearchFilter As Any, ByVal dwAdditionalFlags As Long) As Long Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long Private Declare Function GetTickCount Lib "kernel32.dll" () As Long Private Declare Function GetVersion Lib "kernel32.dll" () As Long Private Const MAX_PATH As Long = 260 Private Const INVALID_HANDLE_VALUE As Long = -1 Private Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Private Type WIN32_FIND_DATA dwFileAttributes As Long ftCreationTime As FILETIME ftLastAccessTime As FILETIME ftLastWriteTime As FILETIME nFileSizeHigh As Long nFileSizeLow As Long dwReserved0 As Long dwReserved1 As Long cFileName As String * MAX_PATH cAlternate As String * 14 End Type Private Enum FINDEX_INFO_LEVELS FindExInfoStandard FindExInfoBasic FindExInfoMaxInfoLevel End Enum Private Enum FINDEX_SEARCH_OPS FindExSearchNameMatch FindExSearchLimitToDirectories FindExSearchLimitToDevices FindExSearchMaxSearchOp End Enum 'FIND FLAGS Private Const FIND_FIRST_EX_CASE_SENSITIVE = 0 Private Const FIND_FIRST_EX_LARGE_FETCH = 2 Private c_cFolders As Collection Private m_Max As Long Private m_IsW7OrLater As Boolean Public Function GetLastFolder(ByVal sStartPath As String) As Collection Dim lR As Long lR = GetVersion If ((lR And &HFF) > 5) And (((lR And &HFF00&) \ &H100) > 0) Then m_IsW7OrLater = True m_Max = 0 Set c_cFolders = New Collection sStartPath = IIf(Right$(sStartPath, 1) = "\", sStartPath, sStartPath & "\") pvFindFolders sStartPath, 0 Set GetLastFolder = c_cFolders End Function Private Sub pvFindFolders(sPath As String, lMax As Long) Dim lRet As Long Dim lhSearch As Long Dim tWFD As WIN32_FIND_DATA Dim svDirs() As String Dim lCount As Long Dim sDir As String Dim i As Long Dim sFolder As String If m_IsW7OrLater Then lhSearch = FindFirstFileEx(sPath & "*", FindExInfoBasic, tWFD, FindExSearchNameMatch, 0&, FIND_FIRST_EX_LARGE_FETCH) Else lhSearch = FindFirstFileEx(sPath & "*", FindExInfoStandard, tWFD, FindExSearchNameMatch, 0&, FIND_FIRST_EX_CASE_SENSITIVE) End If 'lhSearch = FindFirstFile(sPath & "*", tWFD) If Not lhSearch = INVALID_HANDLE_VALUE Then Do If (tWFD.dwFileAttributes And vbDirectory) = vbDirectory Then sFolder = Left$(tWFD.cFileName, lstrlen(tWFD.cFileName)) If InStrB(sFolder, ".") <> 1 Then sDir = sPath & sFolder ReDim Preserve svDirs(lCount) svDirs(lCount) = sDir & "\" lCount = lCount + 1 If lMax > m_Max Then m_Max = lMax Set c_cFolders = New Collection Call c_cFolders.Add(sDir) ElseIf lMax = m_Max Then Call c_cFolders.Add(sDir) End If End If End If lRet = FindNextFile(lhSearch, tWFD) Loop While lRet Call FindClose(lhSearch) For i = 0 To lCount - 1 Call pvFindFolders(svDirs(i), lMax + 1) Next End If End Sub Private Sub Form_Load() Dim cColl As Collection Dim i As Long Dim T As Long T = GetTickCount Set cColl = GetLastFolder("C:\Users\Windows\") Debug.Print GetTickCount - T For i = 1 To cColl.Count Debug.Print cColl(i) Next End Sub
Título: Re: [RETO] Ruta más oculta
Publicado por: Karcrack en 15 Enero 2013, 15:19 pm
@LeandroA: Si filtras las carpetas que contengan un punto vas a quitar varias carpetas a parte de las relativas "." y "..". Como (en mi caso) .ssh, .designer... Por cierto, tal y como tienes el código sería fácil hacer la búsqueda de forma iterativa en lugar de recursiva... ¿No sería mucho más rápido?
Título: Re: [RETO] Ruta más oculta
Publicado por: LeandroA en 15 Enero 2013, 18:51 pm
Hola Karcrack, en principio pense que no se podia crear una carpeta con un punto por delante, almenos el explorer de windows no te deja, ahora que lo mencionas cree una carpeta con el vb y si se pude, asi que si hay que modificar ese filtro no entiendo la diferncia de iterativa a recursiva, como seria iterativa?
Saludos.
Título: Re: [RETO] Ruta más oculta
Publicado por: MCKSys Argentina en 15 Enero 2013, 18:54 pm
La carpeta (o directorio) "." es la carpeta actual.
Si haces en un cmd un "dir .", es lo mismo que hacer solo "dir": Lista el contenido del directorio actual.
Título: Re: [RETO] Ruta más oculta
Publicado por: Karcrack en 15 Enero 2013, 19:14 pm
@LeandroA: Sin llamarte a ti mismo. Haciendo otro bucle antes de FindFirstFileEx cambiando sPath y lMax :-\
Las carpetas empezando por "." son muy comunes en %APPDATA% o %USERPROFILE%. Muchas aplicaciones las crean.
|