como hacer una busqueda

Iniciado por Mr pom0, 4 Septiembre 2008, 22:54 PM

0 Miembros y 1 Visitante están viendo este tema.

Mr pom0

hola alguna persona me podria decir como puedo buscar un archivo que esta en mi computadora con VB

seba123neo

Hola,mira las api's FindFirstFile ,FindNextFile o la de SearchTreeForFile

saludos.
La característica extraordinaria de las leyes de la física es que se aplican en todos lados, sea que tú elijas o no creer en ellas. Lo bueno de las ciencias es que siempre tienen la verdad, quieras creerla o no.

Neil deGrasse Tyson

ssccaann43 ©

Hey mira crea un form asi:



Controles:
-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.


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



Y este codigo 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

Este codigo proviene de www.recursosvisualbasic.com
- Miguel Núñez
Todos tenemos derechos a ser estupidos, pero algunos abusan de ese privilegio...
"I like ^TiFa^"


ssccaann43 ©

Hey perdón... Jajaja yo hasta estoy registrado allí y me pele con el link... Ese es... Saludos
- Miguel Núñez
Todos tenemos derechos a ser estupidos, pero algunos abusan de ese privilegio...
"I like ^TiFa^"