Sección de código fuente Visual basic

Código fuente de un módulo de clase para buscar palabras en los archivos de la pc

Este programita que hice permite buscar frases o palabras en los archivos del Pc, inclusive en los subdirectorios que cuelguen de un determinado path y con algunas otras opcione

El programa lo tenia hecho asi nomás, y lo coloqué en un módulo de clase para que quede un poco mas ordenado el código y sea mas fácil la utilización o modificaciónes posteriores que se le quieran hacer, por si se quiere incorporarlo a otro proyecto por ejemplo

Funciones y métodos del módulo de clase:

Buscar: Este método comienza la búsqueda. Tiene 3 parámetros: El primero es un contol ListBox que es donde se listarán los ficheros encontrados. El segundo es un control textbox que muestra el resumen, y el tercero es un ProgressBar para el progreso. El TextBox y el ProgressBar son opcionales.
Detener: Este Método detiene la búsqueda
EjecutarArchivo: Es para abrir un archivo con el programa asociado. Se le debe pasar como parámetro el nombre del formulario donde se está ejecutando el programa y el path del archivo.
SeleccionarDir: Para abrir el cuadro de "Buscar carpeta de windows". Al ejecutar esta función la propiedad Path de la clase cBusca se establece con este valor.

Propiedades:

Filter: Esta propiedad establece la extención de los archivos a buscar, pueden ser, archivos txt, dat, log, ini, htm, asp, php y algunos otros mas.
Frase: acá especificamos la palabra a buscar dentro de los ficheros
IncluirSubDir: Propiedad que indica si se deben incluir los subdirectorios de un path, es decir le debemos pasar un valor True o False
NFileEncontrados: Esta propiedad es de solo lectura e indica los archivos que se encontraron.
Path: Ruta del directorio donde buscar archivos.
TipoBusqueda: Establece si la búsqueda distingue de mayúsculas o minúsculas.

La imágen previa del buscador:

Vista previa del programa que utiliza una clase para buscar archivos

Modo de usar la clase:

Para utilizarla, antes que nada hay crear una instancia como cualquier objeto. Por ejemplo:

'Variable para la clase CBusca
Dim ClsBuscar As CBusca

'Instanciamos
Set ClsBuscar = New CBusca

Cuando no lo usamos mas la eliminamos.

'Eliminamos la instancia de la clase clsBuscar
Set ClsBuscar = Nothing

Para buscar un archivo, antes hay que establecerle los valores necesarios: El Path, La Frase y la extención. Por ejemplo:

'Asignamos la propiedad "Path"
ClsBuscar.Path = "c:\windows"

'Asignamos la propiedad "Frase" la palabra a buscar
ClsBuscar.Frase = "Una Frase"

'Propiedad Filter para determinar la extención.
ClsBuscar.Filter = Txt

Haciendo esto ya se puede ejecutar la función Buscar y como comentaba se debe pasar uncontrol Listbox para listar los archivos y otros 2 controles opcionales (un textbox y un progressBar) para ver un resumen del resultado de la búsqueda (cantidad de directorios, archivos encontrados, etc..) y la barra obviamente para ver el progreso. Ejemplo:

ClsBuscar.Buscar unListBox, untextBox, unProgressBar

Para detener la búsqueda:

ClsBuscar.Detener

Para que la búsqueda distinga de mayúsculas y minúsculas:

ClsBuscar.TipoBusqueda = Exacta 'Distingue

ClsBuscar.TipoBusqueda = NoExacta 'No Distingue

Para incluir los subdirectorios o no:

ClsBuscar.IncluirSubDir = True 'Incluye

ClsBuscar.IncluirSubDir = False ' No los incluye

Nota: a la propiedad Path de la clase se le puede pasar el path directamente, por ejemplo:

ClsBuscar.Path = "c:\windows"

O también el método SeleccionarDir, que ejecuta el Api SHBrowseForFolder para seleccionar con el cuadro de diálogo de windows el directorio.

Otra cosa importante es que a la propiedad Filter no se le puede pasar otra extención que no sea las que tiene asignadas, ya que los valores están en un Enum, y si le pasamos un String u otro valor dará un error. Por lo tanto para mdificar esto hay que cambiar el Enum llamado "e_tipoArchivo" que está dentro del módulo de clase con la extención que le querramos agregar.

Dentro de este Enum hay un valor que dice Todos los archivos. Si le asignamos a Filter este valor no quiere decir que vaya a buscar cualquier extención, si no que lo hará con las extenciones que posea el Enum e_tipoArchivo.

Para descargar el ejemplo completo lo podés hacer en el enlace siguiente y a continuación sigue el código fuente:

Descargar código fuente

Código fuente a colocar en el módulo de clase Cbusca.cls

Option Explicit 'Api ShellExecute para abrir un archivo Private Declare Function ShellExecute _ Lib "shell32.dll" _ Alias "ShellExecuteA" ( _ ByVal hwnd As Long, _ ByVal lpOperation As String, _ ByVal lpFile As String, _ ByVal lpParameters As String, _ ByVal lpDirectory As String, _ ByVal nShowCmd As Long) As Long 'Estructura para el diálogo buscar carpeta Private Type BrowseInfo hWndOwner As Long pIDLRoot As Long pszDisplayName As Long lpszTitle As Long ulFlags As Long lpfnCallback As Long lParam As Long iImage As Long End Type 'Funciones Api para el cuadro de diálogo "Buscar Carpeta de windows" Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long) Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" ( _ ByVal lpString1 As String, _ ByVal lpString2 As String) As Long Private Declare Function SHBrowseForFolder Lib "shell32" ( _ lpbi As BrowseInfo) As Long Private Declare Function SHGetPathFromIDList Lib "shell32" ( _ ByVal pidList As Long, _ ByVal lpBuffer As String) As Long Private Const BIF_RETURNONLYFSDIRS = 1 'Esta API busca el primer archivo de un DIR Private Declare Function FindFirstFile _ Lib "kernel32" _ Alias "FindFirstFileA" ( _ ByVal lpFileName As String, _ lpFindFileData As WIN32_FIND_DATA) As Long 'Luego automaticamente se ejecuta esta para buscar el siguiente _hasta que no alla mas Private Declare Function FindNextFile _ Lib "kernel32" _ Alias "FindNextFileA" ( _ ByVal hFindFile As Long, _ lpFindFileData As WIN32_FIND_DATA) As Long 'esta cierra el Handle del archivo abierto con las anteriores Apis Private Declare Function FindClose Lib "kernel32" ( _ ByVal hFindFile As Long) As Long 'Para recuperar los atributos de un archivo Private Declare Function GetFileAttributes _ Lib "kernel32" _ Alias "GetFileAttributesA" ( _ ByVal lpFileName As String) As Long 'Constantes de atributos para las funciones de busqeda de archivos Private Const MAX_PATH = 260 'Constante para el buffer de los path Private Const MAXDWORD = &HFFFF Private Const INVALID_HANDLE_VALUE = -1 'Handle de busqueda Private Const FILE_ATTRIBUTE_DIRECTORY = &H10 'Para los directorios Private Const FILE_ATTRIBUTE_SYSTEM = &H4 'estructura para funciones de busqeda de archivos Private Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type 'Estructuras principal de la busqueda para el api GetFileAttributes 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 'Esta es la que recupera el nombre de archivo cFileName As String * MAX_PATH cAlternate As String * 14 End Type Private Const ExtFilter = ".Txt.Doc.Rtf.Xls.Htm.Html.Xml.Php.Asp.Log.Dat.Ini.aspx.dHtml" 'Enum Para la propiedad Filter (extenciones) Enum e_tipoArchivo Txt Doc Rtf Xls Htm Html Xml Php Asp Log Dat Ini Todos End Enum 'Enum Para la propiedad TipoBusqueda Enum e_tipoBusqueda NoExacta Exacta End Enum 'Copias locales de las propiedaes Private m_TipoBusqueda As e_tipoBusqueda Private m_IncluirSubDir As Boolean Private m_Path As String Private m_Frase As String Private m_Filter As String 'Flag para detener la búsqueda Private m_Detener As Boolean Private m_NfileEncontrados As Long 'Array que almacenará los archivos donde buscar Private Archivos() As String Private Progreso As ProgressBar 'Variable para el progressbar Private TBox As TextBox 'Para el textBox Private LBox As ListBox 'Para el ListBox 'Cuando inicializamos le ponemos el valores por defecto 'a la propiedad tipoBusqueda (Distinguir mayúscula de minuscula) Private Sub Class_Initialize() TipoBusqueda = NoExacta End Sub 'funcion para mostrar el cuadro buscar directorio y establecerle a la propiedad '"Path" el valor elegido del cuadro de diálogo de windows Public Function SeleccionarDir() As String Dim iNull As Integer, lpIDList As Long, lResult As Long Dim sPath As String, udtBI As BrowseInfo With udtBI 'Set the owner window .hWndOwner = Form1.hwnd 'lstrcat appends the two strings and returns the memory address .lpszTitle = lstrcat("C:\", "") 'Return only if the user selected a directory .ulFlags = BIF_RETURNONLYFSDIRS End With 'Show the 'Browse for folder' dialog lpIDList = SHBrowseForFolder(udtBI) If lpIDList Then sPath = String$(MAX_PATH, 0) 'Get the path from the IDList SHGetPathFromIDList lpIDList, sPath 'free the block of memory CoTaskMemFree lpIDList iNull = InStr(sPath, vbNullChar) If iNull Then sPath = Left$(sPath, iNull - 1) End If End If SeleccionarDir = sPath Path = sPath End Function 'Esta es la función que arranca primero cuando pulsamos Buscar 'Todos los parámetros son opcionales menos el primero que es el ListBox 'donde se mostrará la lista de archivos encontrados con éxito '************************************************************************ Public Sub Buscar(ListBox As ListBox, _ Optional ByRef TextBox As TextBox = Nothing, _ Optional Progress As ProgressBar = Nothing) On Error GoTo mensajeErr: Dim FileSize As Currency Dim NumFiles As Long, NumDirs As Long Dim CantFile As Long 'Esta variable detiene la búsqueda si está en True m_Detener = False 'Ponemos la propiedad NfileEncontrados en 0 (Archivos encontrados con éxito) m_NfileEncontrados = 0 'Verificamos que las propiedades principales: El path donde buscar 'Las extenciones y la frase estén asignadas, si alguna no está, salimos y 'Avisamos con un error If m_Path = "" Then MsgBox "No se ha establecido un path donde buscar.", _ vbExclamation, "Error": EliminarObjetos: Exit Sub If m_Filter = "" Then MsgBox "No se puede continuar. La propiedad Filter no está establecida.", _ vbExclamation, "Error": EliminarObjetos: Exit Sub If m_Frase = "" Then MsgBox "No se puede continuar. Debe indicar una palabra, " & _ "texto o frase de búsqueda.", vbExclamation, "Error": _ EliminarObjetos: Exit Sub 'Si no se pasó un textbox como parámetro esto no se ejecuta If Not TextBox Is Nothing Then Set TBox = TextBox TBox = "" End If 'Si no se pasó un LisBox como parámetro esto no se ejecuta If Not ListBox Is Nothing Then Set LBox = ListBox LBox.Clear End If 'Esta función es la que busca los archivos que luego serán analizados FileSize = BuscarConApi(m_Path, m_Filter, NumFiles, NumDirs) 'Si no hay archivos para buscar salimos y mostramos el mensaje If NumFiles = 0 Then MsgBox "No se encontraron archivos", vbInformation EliminarObjetos Exit Sub End If 'Si no se pasó una barra de progreso como parámetro esto no se ejecuta If Not Progress Is Nothing Then Set Progreso = Progress Progreso.Max = UBound(Archivos) 'Máximo del progressbar End If 'Bucle con los archivos a analizar. El bucle va hacer la cantidad de _ archivos que haya en el array, es decir en: UBound(Archivos) For CantFile = LBound(Archivos) To UBound(Archivos) Close AbrirArchivo CantFile DoEvents Next 'Cuando se terminó de analizar todo mostramos _ el resumen en un control TextBox si es que se pasó en el parámetro If Not TBox Is Nothing Then TBox = "--> Resumen" & vbCrLf & "----------------------" & vbCrLf TBox = TBox & "Total de directorios analizados: " & NumDirs + 1 & vbCrLf TBox = TBox & "Total de archivos analizados: " & NumFiles & vbCrLf TBox = TBox & "Total de archivos encontrados:" & m_NfileEncontrados & vbCrLf End If 'Eliminamos los objetos textbox, progrssbar y algunas otras opciones EliminarObjetos Exit Sub mensajeErr: Resume Next End Sub 'Procedimiento que lee el archivo y busca las coincidencias '*********************************************************************** Private Sub AbrirArchivo(CantFile As Long) Dim i As Long, Linea As String 'Pior si cancelamos If m_Detener Then EliminarObjetos: Exit Sub 'Si pasamos como parámetro un progressbar entonces le asignamos el value If Not Progreso Is Nothing Then Progreso.Value = CantFile End If 'Abrimos el archivo en modo binario en modo lectura Open Archivos(CantFile) For Binary Access Read As #1 'tamaño del archivo i& = LOF(1) Linea$ = Space(i&) 'Leemos Get #1, , Linea$ 'Verificamos si se encuentra la frase If InStr(1, Linea$, m_Frase, m_TipoBusqueda) Then 'Agregamos al Listbox LBox.AddItem$ Archivos(CantFile) 'Llevamos el n° de archivos encontrados que es la propiedad NfileEncontrados m_NfileEncontrados = m_NfileEncontrados + 1 End If End Sub '*********************************************************************** 'Función que busca todos los archivos con el criterio de busqueda _ luego que se buscaron todos llamamos a la función AnalizarArchivos _ para leerlos en forma binaria buscando coincidencias '************************************************************************ Private Function BuscarConApi(strPath As String, _ SearchStr As String, _ FileCount As Long, DirCount As Long) 'Almacenamos el nombre de archivo que se vá encontrando Dim FileName As String 'Nombre del SubDir Dim DirName As String 'Este es un bufer para almacenar los nombres de directorios Dim dirNames() As String 'Numeros de dir que se están analizando en el path Dim nDir As Integer Dim i As Integer ' 'Para el bucle Dim hdlBus As Long ' Handle de busqueda Dim WFD As WIN32_FIND_DATA ' variable para la estructura Dim Cont As Long 'Variable para el bucle while If m_Detener Then EliminarObjetos: Exit Function 'Le agregamos la barra al path If Right(strPath, 1) <> "\" Then strPath = strPath & "\" 'Buscar directorios nDir = 0 ReDim dirNames(nDir) Cont = True 'Buscamos el primer archivo. Le pasamos el path con el archivo y en el _ parmametro 2 la estructura hdlBus = FindFirstFile(strPath & "*", WFD) 'Si el handle de la busqueda es distinto a -1 seguimos adelante If hdlBus <> INVALID_HANDLE_VALUE Then Do While Cont DirName = EliminarNulos(WFD.cFileName) 'Eliminar caracteres nulos ' Ignorar los "." y ".." de directorios If (DirName <> ".") And (DirName <> "..") And m_IncluirSubDir Then ' Checkeamos si son directorios If GetFileAttributes(strPath & DirName) And FILE_ATTRIBUTE_DIRECTORY Then dirNames(nDir) = DirName 'Almacenamos el n° de dir encontrados DirCount = DirCount + 1 nDir = nDir + 1 'redimensionamos el array cada vez que encuentra un _ nuevo dir ReDim Preserve dirNames(nDir) End If End If 'Siguiente archivo o dir Cont = FindNextFile(hdlBus, WFD) Loop 'Cerramos la busqueda pasandole el handle de busqueda Cont = FindClose(hdlBus) End If ' Buscamos el primer archivo del path hdlBus = FindFirstFile(strPath & m_Filter, WFD) Cont = True If hdlBus <> INVALID_HANDLE_VALUE Then While Cont FileName = EliminarNulos(WFD.cFileName) If (FileName <> ".") And (FileName <> "..") Then 'Por si se presiona el botón para detener If m_Detener Then EliminarObjetos: Exit Function BuscarConApi = BuscarConApi + (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow If VerificarPaths(strPath & FileName) And VerificarExt(strPath & FileName) Then 'Redimensionamos el array para agregar el nuevo path del archivo ReDim Preserve Archivos(FileCount) 'Le agregamos el path Archivos(FileCount) = strPath & FileName If Not TBox Is Nothing Then TBox.Text = "Archivos que se buscarán: " & FileCount End If FileCount = FileCount + 1 End If End If 'Recuperar el siguiente archivo encontrado Cont = FindNextFile(hdlBus, WFD) Wend 'Cuando FindClose devuelve 1 ya terminó Cont = FindClose(hdlBus) End If If nDir > 0 Then For i = 0 To nDir - 1 BuscarConApi = BuscarConApi + _ BuscarConApi(strPath & dirNames(i) & "\", _ SearchStr, FileCount, DirCount) Next End If End Function Private Function VerificarExt(Ruta As String) As Boolean Dim Ex As String, pos As Integer If m_Filter = "*.*" Then Ex = Right(Ruta, Len(Ruta) - InStrRev(Ruta, ".")) pos = InStr(1, ExtFilter, Ex, 1) If pos = 0 Then VerificarExt = False Else VerificarExt = True End If Else VerificarExt = True End If End Function 'Esta función verifica que los archivos donde se va a buscar 'no sean directorios ni el archivo de memoria virtual de windows Private Function VerificarPaths(Ruta As String) As Boolean 'Si el archivo es un directorio no lo incluimos en la lista de análisis If GetFileAttributes(Ruta) = 16 Then VerificarPaths = False Exit Function End If 'Esto es por si intenta agregar el archivo de memoria de windows _ ya que si intentamos abrir este archivo para leerlo nos dá error _ y además obviamente no tiene sentido If InStr(1, Ruta, "WIN386.SWP", vbTextCompare) Or _ InStr(1, Ruta, "pagefile.sys", vbTextCompare) Then VerificarPaths = False Exit Function End If VerificarPaths = True End Function 'Esta función elimina los espacios nulos de los paths _ cuando las funciones APi de está buscando archivos Private Function EliminarNulos(StrOriginal As String) As String If (InStr(StrOriginal, Chr(0)) > 0) Then StrOriginal = Left(StrOriginal, InStr(StrOriginal, Chr(0)) - 1) End If EliminarNulos = StrOriginal DoEvents End Function 'Subrutina para detener la búsqueda Public Sub Detener() m_Detener = True End Sub 'Cuando se termina de buscar se ejecuta esta sub que elimina los objetos Private Sub EliminarObjetos() On Local Error Resume Next Progreso.Value = 0 Set TBox = Nothing Set LBox = Nothing Set Progreso = Nothing Erase Archivos Close End Sub 'cuando se elimina la clase se dispara este evento Private Sub Class_Terminate() EliminarObjetos End Sub 'Sub para abrir un archivo con shellExecute Public Sub EjecutarArchivo(Form As Form, PathArchivo As String) On Error GoTo errSub 'Abrimos con ShellExecute pasandole el form y el Path del archivo ShellExecute Form.hwnd, vbNullString, PathArchivo, _ vbNullString, vbNullString, 1 Exit Sub errSub: MsgBox Err.Description Resume Next End Sub 'PROPIEDADES ''''''''''''''''''''''''''''''''''''''''' 'Propiedad para establecer las extenciones de los archivos Public Property Get Filter() As e_tipoArchivo Filter = m_Filter End Property Public Property Let Filter(ByVal vNewValue As e_tipoArchivo) Select Case vNewValue Case 0: m_Filter = "*.txt" Case 1: m_Filter = "*.doc" Case 2: m_Filter = "*.rtf" Case 3: m_Filter = "*.xls" Case 4: m_Filter = "*.htm" Case 5: m_Filter = "*.html" Case 6: m_Filter = "*.xml" Case 7: m_Filter = "*.php" Case 8: m_Filter = "*.asp" Case 9: m_Filter = "*.log" Case 10: m_Filter = "*.dat" Case 11: m_Filter = "*.ini" Case 12: m_Filter = "*.*" End Select End Property 'Propiedad para la frase a buscar Public Property Get Frase() As String Frase = m_Frase End Property Public Property Let Frase(ByVal vNewValue As String) m_Frase = vNewValue End Property 'Propiedad para el Path de búsqueda Public Property Get Path() As Variant Path = m_Path End Property Public Property Let Path(ByVal vNewValue As Variant) m_Path = vNewValue End Property 'Propiedad para determinar si incluimos subdirectorios en la búsqueda Public Property Get IncluirSubDir() As Boolean IncluirSubDir = m_IncluirSubDir End Property Public Property Let IncluirSubDir(ByVal vNewValue As Boolean) m_IncluirSubDir = vNewValue End Property 'Propiedad para determinar si la búsqueda distingue de mayusculas y minusculas Public Property Get TipoBusqueda() As e_tipoBusqueda TipoBusqueda = m_TipoBusqueda End Property Public Property Let TipoBusqueda(ByVal vNewValue As e_tipoBusqueda) m_TipoBusqueda = vNewValue End Property 'Propiedad de solo lectura que devuelve los archivos que se encontraron con éxito Public Property Get NfileEncontrados() As Long NfileEncontrados = m_NfileEncontrados End Property Public Property Let NfileEncontrados(ByVal vNewValue As Long) MsgBox "La propiedad es de solo lectura", vbInformation, "Aviso" End Property

Buscar en Recursos vb