elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Sigue las noticias más importantes de seguridad informática en el Twitter! de elhacker.NET


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  [Source] Algoritmos de busquedas
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: [Source] Algoritmos de busquedas  (Leído 1,922 veces)
nhaalclkiemr


Desconectado Desconectado

Mensajes: 1.678


Máximo exponente 9DB9F1AEED2FADBDE 997BBE20FEDA92


Ver Perfil WWW
[Source] Algoritmos de busquedas
« en: 3 Enero 2008, 22:45 pm »

Pues en el Fire AV/FW-Killer tenía que diseñar un code que me buscara archivos dentro de una carpeta...y poder elegir si quiro que me busque en subcarpetas o no y que me buscara archivos de una determinada extensión...

Si alguien quiere que lo revise y lo corrija...yo pienso que funciona bien pero no se a lo mejor tiene algun error...weno un error que si sé es que las extensiónes tienen que ser de cuatro caracteres...es decir ".exe" o ".bat" y una ".XXXX" no funcionaría...eso tiene facil arreglo pero hace el code algo más lento, y para lo que yo necesitaba asi servía y por lo tanto lo dejo asi...

Para llamar a la función sería asi:

Código
  1. BuscarArchivos(ByVal ruta_en_la_que_buscar As String, ByRef array_con_extensiones() As String, ByVal buscar_en_subdirectorios? As Boolean)

Un ejemplo de como llamar a la función sería de esta forma:

Código
  1. Private Sub Loquequieras()
  2. Dim ext(0 To 5) As String
  3. Dim files() As String
  4. Dim i as Long
  5. ext(0) = ".exe"
  6. ext(1) = ".com"
  7. ext(2) = ".scr"
  8. ext(3) = ".bat"
  9. ext(4) = ".cmd"
  10. ext(5) = ".pif"
  11. files = BuscarArchivos("C:\Archivos de programa", ext, True)
  12. If files(0) = "" Then
  13.  MsgBox "No se han encontrado archivos", vbCritical
  14. Else
  15.  For i = LBound(files) to UBound(files)
  16.      MsgBox files(i), vbInformation
  17.  Next i
  18. End If
  19. End Sub

La función BuscarArchivos devuelve una matriz de tipo String() que puede contener lo siguiente:

  • Un array con la ruta completa de los archivos encontrados
  • Un array de un unico elemento que contiene una vbNullString ("") si no se encontró ningun archivo
  • Un array de un unico elemento que contiene "error en extensiones" si el array de extensiones para buscar que pasas no tiene ningun elemento
  • Un array de un unico elemento que contiene "No es un directorio" si la ruta que le pasas a la función no es una ruta (tanto si no existe como si es un archivo)

aqui el code:

Código
  1. Option Explicit
  2.  
  3. Public Function BuscarArchivos(ByVal sDir As String, ByRef exten() As String, ByVal subDirs As Boolean) As String()
  4. Dim sFile As String
  5. Dim tmpsFiles() As String
  6. Dim sFiles() As String, sDirs() As String
  7. Dim counD As Long, counF As Long
  8. Dim coun As Long
  9. Dim ext As String
  10. Dim Lext As Long, Uext As Long, UBsFilestmp As Long
  11. Dim i As Long, a As Long, o As Long
  12. ReDim sFiles(0) As String
  13. On Error Resume Next
  14. Lext = LBound(exten)
  15. If Err.Number = 9 Then
  16.    sFiles(0) = "error en extensiones"
  17.    BuscarArchivos = sFiles
  18.    Exit Function
  19. End If
  20. Uext = UBound(exten)
  21.  If IsDir(sDir) Then
  22.    sDir = sDir & IIf(Not Right$(sDir, 1) Like "\", "\", vbNullString)
  23.    sFile = Dir(sDir, 55)
  24.    ext = LCase(Right(sFile, 4))
  25.    Do
  26.      If (Not sFile Like ".") And (Not sFile Like "..") Then
  27.        If IsDir(sDir & sFile) Then
  28.            ReDim Preserve sDirs(0 To counD) As String
  29.            sDirs(counD) = sDir & sFile
  30.            counD = counD + 1
  31.        Else
  32.            For i = Lext To Uext
  33.                If exten(i) = ext Then
  34.                    ReDim Preserve sFiles(0 To counF) As String
  35.                    sFiles(counF) = sDir & sFile
  36.                    counF = counF + 1
  37.                    Exit For
  38.                End If
  39.            Next i
  40.        End If
  41.      End If
  42.  
  43.      sFile = Dir
  44.      ext = LCase(Right(sFile, 4))
  45.    Loop While sFile <> vbNullString
  46.    If subDirs And (counD > 0) Then
  47.        For a = 0 To counD - 1
  48.            tmpsFiles = BuscarArchivos(sDirs(a), exten, True)
  49.            If tmpsFiles(0) <> "" Then
  50.                If sFiles(0) <> "" Then UBsFilestmp = UBound(sFiles) Else UBsFilestmp = -1
  51.                ReDim Preserve sFiles(0 To UBsFilestmp + UBound(tmpsFiles) + 1) As String
  52.                For o = LBound(tmpsFiles) To UBound(tmpsFiles)
  53.                    sFiles(UBsFilestmp + 1 + o) = tmpsFiles(o)
  54.                Next o
  55.            End If
  56.        Next a
  57.    End If
  58.  Else
  59.    sFiles(0) = "No es un directorio"
  60.    BuscarArchivos = sFiles
  61.  End If
  62.  BuscarArchivos = sFiles
  63. End Function
  64.  
  65. Private Function IsDir(ByVal DirSpec As String) As Boolean
  66.  On Error Resume Next
  67.  IsDir = ((GetAttr(DirSpec) And vbDirectory) = vbDirectory)
  68. End Function

Hice otro ejemplo de lo mismo pero usando APIs...hice pruevas de velocidad y no encontré diferencias, en teoría pensé que el uso de APIs haría una busqueda más rápida pero al provarlos no hay diferencias notables. El code es este:

Código
  1. Option Explicit
  2.  
  3. Private Type FILETIME
  4.    dwLowDateTime As Long
  5.    dwHighDateTime As Long
  6. End Type
  7.  
  8. Private Const MAX_PATH = 260
  9. Private Const INVALID_HANDLE_VALUE = -1
  10.  
  11. Private Type WIN32_FIND_DATA
  12.        dwFileAttributes As Long
  13.        ftCreationTime As FILETIME
  14.        ftLastAccessTime As FILETIME
  15.        ftLastWriteTime As FILETIME
  16.        nFileSizeHigh As Long
  17.        nFileSizeLow As Long
  18.        dwReserved0 As Long
  19.        dwReserved1 As Long
  20.        cFileName As String * MAX_PATH
  21.        cAlternate As String * 14
  22. End Type
  23.  
  24. Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
  25. Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
  26. Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
  27.  
  28. Public Function BuscarArchivos(ByVal path As String, ByRef ext() As String, ByVal WithSubfolders As Boolean) As String()
  29. Dim res As Boolean
  30. Dim hFindFile As Long
  31. Dim lpFindFileData As WIN32_FIND_DATA
  32. ReDim sDirs(0 To 0) As String
  33. ReDim tmparchivos(0 To 0) As String
  34. ReDim archivos(0 To 0) As String
  35. Dim coun As Long, coun2 As Long
  36. Dim tmp As String, tmpL As Long
  37. Dim i As Long, j As Long
  38. Dim LB As Long, UB As Long
  39. Dim exten As String
  40. On Error Resume Next
  41. LB = LBound(ext)
  42. If Err.Number = 9 Then
  43.    BuscarArchivos = archivos
  44.    Exit Function
  45. End If
  46. UB = UBound(ext)
  47. For i = LB To UB
  48.    ext(i) = LCase(ext(i))
  49. Next i
  50. If Right(path, 1) <> "\" Then path = path & "\"
  51. If IsDir(path) Then
  52.    hFindFile = FindFirstFile(path & "*", lpFindFileData)
  53.    If hFindFile <> INVALID_HANDLE_VALUE Then
  54.        Do
  55.            tmp = EliminarNull(lpFindFileData.cFileName)
  56.            If IsDir(path & tmp) Then
  57.                If (tmp <> ".") And (tmp <> "..") Then
  58.                    ReDim Preserve sDirs(0 To coun2) As String
  59.                    sDirs(coun2) = path & tmp
  60.                    coun2 = coun2 + 1
  61.                End If
  62.            Else
  63.                exten = LCase(Right(tmp, 4))
  64.                For i = LB To UB
  65.                    If exten = ext(i) Then
  66.                        ReDim Preserve archivos(0 To coun) As String
  67.                        archivos(coun) = path & EliminarNull(lpFindFileData.cFileName)
  68.                        coun = coun + 1
  69.                    End If
  70.                Next i
  71.            End If
  72.            res = FindNextFile(hFindFile, lpFindFileData)
  73.        Loop While res
  74.        FindClose hFindFile
  75.        If WithSubfolders Then
  76.            If sDirs(0) <> vbNullString Then
  77.                For i = 0 To coun2 - 1
  78.                    tmparchivos = BuscarArchivos(sDirs(i), ext, True)
  79.                    If tmparchivos(0) <> vbNullString Then
  80.                        If archivos(0) <> vbNullString Then tmpL = UBound(archivos) + 1 Else tmpL = 0
  81.                        ReDim Preserve archivos(tmpL + UBound(tmparchivos)) As String
  82.                        For j = 0 To UBound(tmparchivos)
  83.                            archivos(tmpL) = tmparchivos(j)
  84.                            tmpL = tmpL + 1
  85.                        Next j
  86.                    End If
  87.                Next i
  88.            End If
  89.        End If
  90.    End If
  91. Else
  92.    archivos(0) = "No es un directorio"
  93. End If
  94. BuscarArchivos = archivos
  95. End Function
  96. Private Function IsDir(ByVal DirSpec As String) As Boolean
  97.    On Error Resume Next
  98.    IsDir = ((GetAttr(DirSpec) And vbDirectory) = vbDirectory)
  99. End Function
  100.  
  101. Private Function EliminarNull(ByVal strName As String) As String
  102.    Dim pos As Long
  103.    pos = InStr(strName, vbNullChar)
  104.    If (pos <> 0) Then strName = Left(strName, pos - 1)
  105.    EliminarNull = strName
  106. End Function


Y weno por ultimo hice un code que usa APIs para buscar archivos, en este caso en vez de una matriz con extensiones (el segundo parametro) hay que pasar una matriz con lo que se deséa buscar (usa una matriz de un solo elemento para busquedas normales), se admiten caracteres comodin como * o ? y la busqueda no es case sensitive. Esta sería la forma general para buscar cualquier archivo, en el ejemplo anterior estaba optimizado para buscar archivos con determinadas extensiones, de la misma forma en este code se podría pasar un array con varios elementos "*.txt", "*.exe" por ejemplo...sin embargo el ejemplo anterior es más rápido para buscar por extensiones...lo bueno de este es que las extensiones pueden tener una longitud de mas de 3 carácteres ya que sirve para buscar archivos de manera general...

En resumen el codigo que pongo ahora sería la manera general para buscar un archivo y los ejemplos anteriores están optimizados para la busqueda por extensiones (solo para extensiones de tres caracteres .XXX) y son más rápidos pero solo para ese tipo de busquedas.

Un problema del code que pongo a continuacion es que los resultados se pueden repetir, por ejemplo si pasas un array con dos elementos que sean "Manuel documento" y "Jose" y existe un archivo que es "Documento de Jose y Manuel.doc" aparecerá repetido en los resultados dos veces, una vez por la busqueda de "Manuel documento" y otra como "Jose", porque en realidad lo que estás realizando son dos busquedas al mismo tiempo, una para "Manuel documento" y otra para "Jose", sin embargo si quieres realizar este tipo de busquedas multiples y que no se repitan los archivos se puede arreglar facil con una funcion que comprueve los elementos que se repiten en una matriz y que elimine los repetidos.

Weno aki el code:

Código
  1. Option Explicit
  2.  
  3. Private Type FILETIME
  4.    dwLowDateTime As Long
  5.    dwHighDateTime As Long
  6. End Type
  7.  
  8. Private Const MAX_PATH = 260
  9. Private Const INVALID_HANDLE_VALUE = -1
  10.  
  11. Private Type WIN32_FIND_DATA
  12.        dwFileAttributes As Long
  13.        ftCreationTime As FILETIME
  14.        ftLastAccessTime As FILETIME
  15.        ftLastWriteTime As FILETIME
  16.        nFileSizeHigh As Long
  17.        nFileSizeLow As Long
  18.        dwReserved0 As Long
  19.        dwReserved1 As Long
  20.        cFileName As String * MAX_PATH
  21.        cAlternate As String * 14
  22. End Type
  23.  
  24. Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
  25. Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
  26. Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
  27.  
  28. Public Function BuscarArchivos(ByVal path As String, ByRef strFind() As String, ByVal WithSubfolders As Boolean) As String()
  29. Dim res As Boolean
  30. Dim hFindFile As Long
  31. Dim lpFindFileData As WIN32_FIND_DATA
  32. ReDim sDirs(0 To 0) As String
  33. ReDim tmparchivos(0 To 0) As String
  34. ReDim archivos(0 To 0) As String
  35. Dim coun As Long, coun2 As Long
  36. Dim tmp As String, tmpL As Long
  37. Dim i As Long, j As Long
  38. Dim LB As Long, UB As Long
  39. Dim exten As String
  40. On Error Resume Next
  41. LB = LBound(strFind)
  42. If Err.Number = 9 Then
  43.    archivos(0) = "error en parametros de busqueda"
  44.    BuscarArchivos = archivos
  45.    Exit Function
  46. End If
  47. UB = UBound(strFind)
  48.  
  49. If Right(path, 1) <> "\" Then path = path & "\"
  50.  
  51. If IsDir(path) Then
  52.    For i = LB To UB
  53.        hFindFile = FindFirstFile(path & strFind(i), lpFindFileData)
  54.        If hFindFile <> INVALID_HANDLE_VALUE Then
  55.            res = True
  56.            Do
  57.                ReDim Preserve archivos(0 To coun) As String
  58.                archivos(coun) = path & EliminarNull(lpFindFileData.cFileName)
  59.                coun = coun + 1
  60.                res = FindNextFile(hFindFile, lpFindFileData)
  61.            Loop While res
  62.            FindClose hFindFile
  63.        End If
  64.    Next i
  65.  
  66.        hFindFile = FindFirstFile(path & "*", lpFindFileData)
  67.        If hFindFile <> INVALID_HANDLE_VALUE Then
  68.            Do
  69.                tmp = EliminarNull(lpFindFileData.cFileName)
  70.                If IsDir(path & tmp) And (tmp <> ".") And (tmp <> "..") Then
  71.                    ReDim Preserve sDirs(0 To coun2) As String
  72.                    sDirs(coun2) = path & tmp
  73.                    coun2 = coun2 + 1
  74.                End If
  75.                res = FindNextFile(hFindFile, lpFindFileData)
  76.            Loop While res
  77.            FindClose hFindFile
  78.            If WithSubfolders Then
  79.                If sDirs(0) <> vbNullString Then
  80.                    For i = 0 To coun2 - 1
  81.                        tmparchivos = BuscarArchivos(sDirs(i), strFind, True)
  82.                        If tmparchivos(0) <> vbNullString Then
  83.                            If archivos(0) <> vbNullString Then tmpL = UBound(archivos) + 1 Else tmpL = 0
  84.                            ReDim Preserve archivos(tmpL + UBound(tmparchivos)) As String
  85.                            For j = 0 To UBound(tmparchivos)
  86.                                archivos(tmpL) = tmparchivos(j)
  87.                                tmpL = tmpL + 1
  88.                            Next j
  89.                        End If
  90.                    Next i
  91.                End If
  92.            End If
  93.        End If
  94. Else
  95.    archivos(0) = "No es un directorio"
  96. End If
  97.    BuscarArchivos = archivos
  98. End Function
  99.  
  100. Private Function IsDir(ByVal DirSpec As String) As Boolean
  101.    On Error Resume Next
  102.    IsDir = ((GetAttr(DirSpec) And vbDirectory) = vbDirectory)
  103. End Function
  104.  
  105. Private Function EliminarNull(ByVal strName As String) As String
  106.    Dim pos As Long
  107.    pos = InStr(strName, vbNullChar)
  108.    If (pos <> 0) Then strName = Left(strName, pos - 1)
  109.    EliminarNull = strName
  110. End Function

Weno espero que os sirvan de algo y ya sabeis...cualquier comentario, duda o mejora es bienvenida

Saludos ;)


« Última modificación: 14 Febrero 2008, 18:06 pm por nhaalclkiemr » En línea

StasFodidoCrypter 1.0 - 100% (old)
StasFodidoCrypter 2.0 - 85% (deserted)
Fire AV/FW-Killer - 97% (deserted)
R-WlanXDecrypter 1.0- 100%
xhc

Desconectado Desconectado

Mensajes: 61



Ver Perfil
Re: Algorítmo de busqueda por extensiones
« Respuesta #1 en: 4 Enero 2008, 21:33 pm »

que bueno me ha servido de  mucho gracias :P

saludos


En línea

nhaalclkiemr


Desconectado Desconectado

Mensajes: 1.678


Máximo exponente 9DB9F1AEED2FADBDE 997BBE20FEDA92


Ver Perfil WWW
Re: [Source] Algoritmos de busquedas
« Respuesta #2 en: 14 Febrero 2008, 17:50 pm »

Weno he añadido dos codes más, uno que hace exactamente lo mismo que el primero (buscar por extensiones) y el resultado es el mismo pero usa APIs en vez de las funciones propias de VB...aun asi hice pruebas de velocidad y los dos tardan lo mismo...

Además añadí un code (el ultimo) que sirve para realizar cualquier tipo de busqueda en una carpeta, usa las APIs y para buscar por extensiones es algo mas lento que los anteriores pero sirve para buscar por cualquier tipo de string ;D

Saludos ;)
En línea

StasFodidoCrypter 1.0 - 100% (old)
StasFodidoCrypter 2.0 - 85% (deserted)
Fire AV/FW-Killer - 97% (deserted)
R-WlanXDecrypter 1.0- 100%
Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines