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 dr As New StringBuilder
For Each drive In DriveInfo.
GetDrives 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