Sección de códigos, trucos y ejemplos para visual basic

Clic para descargar Velneo Open source Software - Plataforma para el desarrollo de aplicaciones sobre base de datos

8 - Buscar archivos usando algunas funciones Api de Windows

Ejemplo que muestra como buscar archivos y directorios mediante algunas funciones del Api

El ejemplo permite buscar archivos incluyendo subdirectorios, también podemos buscar un determinado fichero como también por extenciones, ..como lo hace windows, y utilizando comodines para la búsqueda

Además, la función que busca, retorna el tamaño total en bytes de los ficheros encontrados y el número de directorios o carpetas

Las funciones del Api que se usan son:

FindFirstFile : busca el primer archivo en el directorio
FindNextFile : busca el siguiente
FindClose : Para cuando finaliza la búsqueda de archivos es necesario liberar los recursos
GetFileAttributes: para los atributos de archivos, en este caso para el tamaño

Vista del formulario de ejemplo para buscar archivos mediante funciones Api

Controles para el ejemplo

Un control textBox llamado Text1 ( para indicar el path donde buscar, por ejemplo c:\carpeta )
Un control textBox para indicar el archivo o los archivos a buscar ( Puede ser un archivos específico o todos los archivos de una determinada extensión, por ejemplo * .doc, o ... *.*, etc..)
Agregar en el proyecto un control command1 ( para buscar )
Añadir un control ListBox llamado List1 para listar los archivos
Agregar un módulo bas

Código fuente En el Módulo bas:

Option Explicit '*************************************************************************** '* Código fuente del módulo bas '*************************************************************************** 'Declaraciones del Api '------------------------------------------------------------------------------ 'Esta función 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 'Esta el siguiente archivo o directorio Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" ( _ ByVal hFindFile As Long, _ lpFindFileData As WIN32_FIND_DATA) As Long Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" ( _ ByVal lpFileName As String) As Long 'Esta cierra el Handle de búsqueda Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long ' Constantes '------------------------------------------------------------------------------ 'Constantes de atributos de archivos Const FILE_ATTRIBUTE_ARCHIVE = &H20 Const FILE_ATTRIBUTE_DIRECTORY = &H10 Const FILE_ATTRIBUTE_HIDDEN = &H2 Const FILE_ATTRIBUTE_NORMAL = &H80 Const FILE_ATTRIBUTE_READONLY = &H1 Const FILE_ATTRIBUTE_SYSTEM = &H4 Const FILE_ATTRIBUTE_TEMPORARY = &H100 'Otras constantes Const MAX_PATH = 260 Const MAXDWORD = &HFFFF Const INVALID_HANDLE_VALUE = -1 'UDT '------------------------------------------------------------------------------ 'Estructura para las fechas de los archivos Private Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type 'Estructura necesaria para la información de archivos 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 '----------------------------------------------------------------------- 'Funciones '----------------------------------------------------------------------- 'Esta función es para formatear los nombres de archivos y directorios. Elimina los CHR(0) '------------------------------------------------------------------------ Function Eliminar_Nulos(OriginalStr As String) As String If (InStr(OriginalStr, Chr(0)) > 0) Then OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1) End If Eliminar_Nulos = OriginalStr End Function 'Esta función es la principal que permite buscar _ los archivos y listarlos en el ListBox Function FindFilesAPI(Path As String, _ SearchStr As String, _ FileCount As Long, _ DirCount As Long, _ ListBox As ListBox) Dim FileName As String Dim DirName As String Dim dirNames() As String Dim nDir As Long Dim i As Long Dim hSearch As Long Dim WFD As WIN32_FIND_DATA Dim Cont As Long If Right(Path, 1) <> "\" Then Path = Path & "\" ' Buscamos por mas directorios nDir = 0 ReDim dirNames(nDir) Cont = True hSearch = FindFirstFile(Path & "*", WFD) If hSearch <> INVALID_HANDLE_VALUE Then Do While Cont DirName = Eliminar_Nulos(WFD.cFileName) ' Ignore the current and encompassing directories. If (DirName <> ".") And (DirName <> "..") Then ' Check for directory with bitwise comparison. If GetFileAttributes(Path & DirName) _ And FILE_ATTRIBUTE_DIRECTORY Then dirNames(nDir) = DirName DirCount = DirCount + 1 nDir = nDir + 1 ReDim Preserve dirNames(nDir) End If End If Cont = FindNextFile(hSearch, WFD) 'Get next subdirectory. Loop Cont = FindClose(hSearch) End If hSearch = FindFirstFile(Path & SearchStr, WFD) Cont = True If hSearch <> INVALID_HANDLE_VALUE Then While Cont FileName = Eliminar_Nulos(WFD.cFileName) If (FileName <> ".") And (FileName <> "..") Then FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) _ + WFD.nFileSizeLow FileCount = FileCount + 1 ListBox.AddItem Path & FileName End If Cont = FindNextFile(hSearch, WFD) ' Get next file Wend Cont = FindClose(hSearch) End If ' Si estos son Sub Directorios...... If nDir > 0 Then For i = 0 To nDir - 1 FindFilesAPI = FindFilesAPI + FindFilesAPI(Path & dirNames(i) & "\", _ SearchStr, FileCount, DirCount, ListBox) Next i End If End Function

Código fuente en el formulario

Option Explicit '*************************************************************************** '* Controles : Command1 ( para buscar) _ Text1 ( para indicar el Path) _ Text2 ( para los archivos, por ejemplo *.txt ) _ List1 '*************************************************************************** Private Sub Command1_Click() Dim Path As String Dim Pattern As String Dim FileSize As Currency Dim Count_Archivos As Long Dim Count_Dir As Long Screen.MousePointer = vbHourglass 'Borramos el contenido del List1 List1.Clear 'Path y archivos a buscar Path = Text1.Text Pattern = Text2.Text 'Llamamos a la función para buscar y que nos retorne algunos datos FileSize = FindFilesAPI(Path, Pattern, _ Count_Archivos, _ Count_Dir, List1) 'Mostramos los resultados 'Cantidad de archivos encontrados MsgBox Count_Archivos & " Archivos encontrados en " & _ Count_Dir + 1 & " Directorios", 64 'Tamaño Total en Bytes de los archivos encontrados MsgBox "Tamaño total de los archivos: " & _ Path & " = " & _ Format(FileSize, "#,###,###,##0") & " Bytes", 64 Screen.MousePointer = vbDefault End Sub Private Sub Form_Load() 'Directorio de windows Text1.Text = Environ("WinDir") 'Archivos txt Text2.Text = "*.txt" Command1.Caption = " >> Buscar " End Sub 'Redimensiona y posiciona los controles '-------------------------------------------------------------- Private Sub Form_Resize() On Local Error Resume Next Text1.Move 0, 0, Me.ScaleWidth Text2.Move 0, Text1.Top + Text1.Height + 50, Me.ScaleWidth List1.Move 0, Text2.Top + 50 + Text2.Height, _ Me.ScaleWidth, Me.ScaleHeight - _ (Text1.Height + Text2.Height + Command1.Height + 100) Command1.Move Me.ScaleWidth - Command1.Width - 50, _ Me.ScaleHeight - (Command1.Height + 50) End Sub

Recursos visual basic 6.0 - Enlaces relacionados

Recursos visual basic.NET - relacionados

Ejemplos varios para trabajar con archivos

Buscar en Recursos vb