últimos mensajes de: _katze_

codigo vieejo y con ayuda de varias, pero la connserve y justo t viene para aprender
Código
Imports System.Runtime.InteropServices
Imports System.Text.RegularExpressions
Imports System.Text
Imports System.IO
 
Public Class ClsBucarFiles
 
#Region "   Icon    "
 
    Private Structure SHFILEINFO
        Public hIcon As IntPtr ' : icon
        Public iIcon As Integer ' : icondex
        Public dwAttributes As Integer ' : SFGAO_ flags
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=260)> _
        Public szDisplayName As String
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=80)> _
        Public szTypeName As String
    End Structure
 
    Private Declare Ansi Function SHGetFileInfo Lib "shell32.dll" (ByVal pszPath As String, _
    ByVal dwFileAttributes As Integer, ByRef psfi As SHFILEINFO, ByVal cbFileInfo As Integer, _
    ByVal uFlags As Integer) As IntPtr
 
    Private Const SHGFI_SMALLICON As Long = &H1
    Private Const SHGFI_SYSICONINDEX As Long = &H4000
    Private Const SHGFI_USEFILEATTRIBUTES As Long = &H10
    Private Const SHGFI_TYPENAME As Long = &H400
    Private Const SHGFI_DISPLAYNAME As Long = &H200
    Private Const SHGFI_ICON = &H100
    Private Const SHGFI_LARGEICON = &H0         ' Large icon
    Private Shared shfitmp As SHFILEINFO   'just used for the following
    Private Shared SHFILESIZE As Integer = Marshal.SizeOf(shfitmp.GetType())
 
    Public Function ptricon(ByVal vsPath As String) As IntPtr
        Dim hImgSmall As IntPtr
        Dim shinfo As New SHFILEINFO()
        shinfo.szDisplayName = New String(Chr(0), 260)
        shinfo.szTypeName = New String(Chr(0), 80)
        hImgSmall = SHGetFileInfo(vsPath, 0&, shinfo, SHFILESIZE, _
        SHGFI_ICON Or SHGFI_SYSICONINDEX Or SHGFI_SMALLICON)
        Return (shinfo.hIcon)
    End Function
 
#End Region
 
#Region " Declaraciones "
    <DllImport("kernel32.dll")> _
    Private Shared Function FindClose(ByVal hFindFile As IntPtr) As Boolean
    End Function
 
    <DllImport("kernel32.dll", CharSet:=CharSet.None)> _
    Private Shared Function FindFirstFile(ByVal lpFileName As String, ByRef lpFindFileData As WIN32_FIND_DATA) As IntPtr
    End Function
 
    Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As IntPtr, ByRef lpFindFileData As WIN32_FIND_DATA) As Boolean
 
    <StructLayout(LayoutKind.Sequential)> _
    Structure WIN32_FIND_DATA
        Public dwFileAttributes As UInteger
        Public ftCreationTime As System.Runtime.InteropServices.ComTypes.FILETIME
        Public ftLastAccessTime As System.Runtime.InteropServices.ComTypes.FILETIME
        Public ftLastWriteTime As System.Runtime.InteropServices.ComTypes.FILETIME
        Public nFileSizeHigh As UInteger
        Public nFileSizeLow As UInteger
        Public dwReserved0 As UInteger
        Public dwReserved1 As UInteger
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=260)> Public cFileName As String
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=14)> Public cAlternateFileName As String
    End Structure
 
 
    Public Event FileFound(ByVal sPath As String, ByVal sFile As String, ByVal atributos As FileAttributes)
    Public Event FolderFound(ByVal sPath As String, ByVal sFolder As String, ByVal atributos As FileAttributes)
 
    Private cancel As Boolean = False
 
    Private INVALID_HANDLE_VALUE As New IntPtr(-1)
 
    Private RegExp As Regex
 
    Private sbFiles As New StringBuilder
 
    Private sbFolders As New StringBuilder
#End Region
 
#Region " PRocedimientos "
 
    Public Sub New()
 
        MyBase.New()
    End Sub
 
    Public Sub start()
        If RegExp Is Nothing Then
            RegExp = New Regex(p_match, RegexOptions.IgnoreCase)
        Else
            RegExp = Nothing
            RegExp = New Regex(p_match, RegexOptions.IgnoreCase)
        End If
 
        cancel = False
 
        Dim arrdrive() As String
 
        arrdrive = p_path.Split(Chr(59))
 
        For Each s As String In arrdrive
            Call SubBusqueda(s) 'recursividad xD
        Next
 
    End Sub
 
    Public Sub Cancelar()
        cancel = True
    End Sub
    Private Function StripNulls(ByVal sData As String) As String
        StripNulls = Left$(sData, Len(sData))
    End Function
    Private Sub SubBusqueda(ByVal vsPath As String)
        Dim ptrSearch As New IntPtr
        Dim vsfile As String = String.Empty
        Dim vsfolder As String = String.Empty
        Dim vaDir As New ArrayList
        Dim wfd As New WIN32_FIND_DATA
        Dim dir As String = String.Empty
        Dim ret As Boolean
 
        If cancel Then Exit Sub
 
        Call NormalizePath(vsPath)
        ptrSearch = FindFirstFile(vsPath & "*", wfd)
 
        If Not ptrSearch = INVALID_HANDLE_VALUE Then
 
            Do
                If (wfd.dwFileAttributes And FileAttributes.Directory) <> FileAttributes.Directory Then
                    vsfile = StripNulls(wfd.cFileName)
 
                    If Not p_hide Then
 
                        If (wfd.dwFileAttributes And FileAttributes.Hidden) = FileAttributes.Hidden Then GoTo FNEXT
 
                    End If
 
                    If RegExp.Matches(vsfile).Count = 0 Then GoTo FNEXT
 
                    sbFiles.AppendLine(vsfile)
 
                    RaiseEvent FileFound(vsPath, vsfile, CType(wfd.dwFileAttributes, FileAttributes))
                Else
 
                    If Not p_hide Then
                        If (wfd.dwFileAttributes And FileAttributes.Hidden) = FileAttributes.Hidden Then GoTo FNEXT
                    End If
 
                    vsfolder = StripNulls(wfd.cFileName)
 
                    If (vsfolder <> ".") And (vsfolder <> "..") Then
                        dir = vsPath & vsfolder & "\"
 
                        If Not p_sys Then
 
                            If dir = Environ("Windir") & "\" Then GoTo FNEXT
                        End If
 
                        vaDir.Add(dir)
                        If RegExp.Matches(vsfolder).Count = 0 Then GoTo FNEXT
                        sbFolders.AppendLine(vsfolder)
                        RaiseEvent FolderFound(vsPath, vsfolder, CType(wfd.dwFileAttributes, FileAttributes))
 
                    End If
                End If
FNEXT:
 
                If cancel Then FindClose(ptrSearch) : Exit Sub
                Application.DoEvents()
 
                ret = FindNextFile(ptrSearch, wfd)
            Loop While ret
            Call FindClose(ptrSearch)
        End If
 
        If p_subfolder Then
 
            For i As Integer = 0 To vaDir.Count - 1
 
                Call SubBusqueda(CStr(vaDir(i)))
            Next
 
        End If
    End Sub
 
    Private Function drivers() As String
        Dim drive As DriveInfo
        Dim dr As New StringBuilder
 
        For Each drive In DriveInfo.GetDrives
            With drive
                If .IsReady Then
                    dr.Append(drive.Name & ";")
                End If
            End With
        Next
        Return dr.ToString
    End Function
 
    Private Function ReplaceFilter(ByVal sFilter As String) As String
        sFilter = sFilter.Replace("+", "\+")
        sFilter = sFilter.Replace(".", "\.")
        sFilter = sFilter.Replace("|", "\|")
        sFilter = sFilter.Replace(";", "|\b")
        sFilter = sFilter.Replace(" ", "|\b")
        sFilter = sFilter.Replace("{", "\{")
        sFilter = sFilter.Replace("}", "\}")
        sFilter = sFilter.Replace("*", ".+")
        sFilter = sFilter.Replace("?", ".{1}")
        sFilter = sFilter.Replace("(", "\(")
        sFilter = sFilter.Replace(")", "\)")
        sFilter = sFilter.Replace("^", "\^")
        sFilter = sFilter.Replace("$", "\$")
        sFilter = sFilter.Replace("[", "\[")
        sFilter = sFilter.Replace("[", "\]")
 
        Do While CBool(InStr(sFilter, "|\b|\b"))
            sFilter = Replace$(sFilter, "|\b|\b", "|\b")
        Loop
        Return "^(" & sFilter & ")$|(" & sFilter & ".+)"
    End Function
 
 
    Public Function NormalizePath(byval sData As String) As String
 
        If Strings.Len(sData) > 1 Then
            sData = Strings.Replace(sData, "/", "\")
            If Not Strings.Right(sData, 1) = "\" Then
                Return sData & "\"
            Else
                Return sData
            End If
        End If
 
    End Function
 
 
#End Region
 
#Region " propiedades "
    Private p_match As String = String.Empty
 
    WriteOnly Property Match() As String
        Set(ByVal value As String)
            p_match = ReplaceFilter(value)
        End Set
    End Property
 
    Private p_subfolder As Boolean = False
    Property SubFolder() As Boolean
        Get
            Return p_subfolder
        End Get
        Set(ByVal value As Boolean)
            p_subfolder = value
        End Set
    End Property
    Private p_hide As Boolean = False
    Property HideFolder() As Boolean
        Get
            Return p_hide
        End Get
        Set(ByVal value As Boolean)
            p_hide = value
        End Set
    End Property
    Private p_sys As Boolean = False
    Property SysFolder() As Boolean
        Get
            Return p_sys
        End Get
        Set(ByVal value As Boolean)
            p_sys = value
        End Set
    End Property
    Private p_path As String = drivers()
    Property Path() As String
        Get
            Return p_path
        End Get
        Set(ByVal value As String)
 
            p_path = NormalizePath(value)
        End Set
    End Property
    ReadOnly Property FilesString() As String
        Get
            Return sbFolders.ToString
        End Get
    End Property
 
    ReadOnly Property FolderString() As String
        Get
 
            Return sbFolders.ToString
        End Get
    End Property
#End Region
 
End Class