Visual Basic

Option Strict Off
Option Explicit On
'Option Infer Off

Imports VB = Microsoft.VisualBasic
Imports System.Runtime.InteropServices


Friend Class Form1
	Inherits System.Windows.Forms.Form

  'Private Declare Function FindFirstFileExW Lib "kernel32.dll" Alias "FindFirstFileExW" (ByVal lpFileName As String, ByVal fInfoLevelId As FINDEX_INFO_LEVELS, ByVal lpFindFileData As WIN32_FIND_DATA, ByVal fSearchOp As FINDEX_SEARCH_OPS, ByRef lpSearchFilter As Int32, ByVal dwAdditionalFlags As Integer) As Long
  Private Declare Function FindFirstFileExW Lib "kernel32.dll" Alias "FindFirstFileExW" (ByVal lpFileName_IntPtr As IntPtr, ByVal fInfoLevelId As FINDEX_INFO_LEVELS, ByRef lpFindFileData_IntPtr As IntPtr, ByVal fSearchOp As FINDEX_SEARCH_OPS, ByRef lpSearchFilter As Int32, ByVal dwAdditionalFlags As Integer) As Long

  Private Declare Function FindNextFileW Lib "kernel32" Alias "FindNextFileW" (ByVal hFindFile As Long, ByRef lpFindFileData As WIN32_FIND_DATA) As Integer

  Private Declare Function GetFileAttributesW Lib "kernel32" Alias "GetFileAttributesW" (ByVal lpFileName As String) As Integer

  Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Integer

  Private Declare Function GetLastError Lib "kernel32" Alias "GetLastError" () As Integer

  Const MAX_PATH As UInt16 = 260
  Const MAXDWORD As UInt64 = 4294967295   '&HFFFFFFFF is not accepted, why?
  Const INVALID_HANDLE_VALUE As Int16 = -1
  Const FILE_ATTRIBUTE_ARCHIVE As UInt16 = &H20
  Const FILE_ATTRIBUTE_DIRECTORY As UInt16 = &H10
  Const FILE_ATTRIBUTE_HIDDEN As UInt16 = &H2
  Const FILE_ATTRIBUTE_NORMAL As UInt16 = &H80
  Const FILE_ATTRIBUTE_READONLY As UInt16 = &H1
  Const FILE_ATTRIBUTE_SYSTEM As UInt16 = &H4
  Const FILE_ATTRIBUTE_TEMPORARY As UInt16 = &H100

'------------------------------------------------------------
'------------------------------------------------------------
'------------------------------------------------------------
'These are specifically for the FindFirstFileEx() function:

Public Enum FINDEX_INFO_LEVELS
  FindExInfoStandard = 0
  FindExInfoBasic = 1
  FindExInfoMaxInfoLevel = 2
End Enum

 Enum FINDEX_SEARCH_OPS
  FindExSearchNameMatch = 0
  FindExSearchLimitToDirectories = 1
  FindExSearchLimitToDevices = 2
End Enum
'------------------------------------------------------------
'------------------------------------------------------------
'------------------------------------------------------------

  Private Structure FILETIME
    Dim dwLowDateTime As UInt32
    Dim dwHighDateTime As UInt32
  End Structure

  Private Structure WIN32_FIND_DATA
    Dim dwFileAttributes As UInt32
    Dim ftCreationTime As FILETIME
    Dim ftLastAccessTime As FILETIME
    Dim ftLastWriteTime As FILETIME
    Dim nFileSizeHigh As UInt32
    Dim nFileSizeLow As UInt32
    Dim dwReserved0 As UInt32
    Dim dwReserved1 As UInt32

    <VBFixedString(MAX_PATH), MarshalAs(UnmanagedType.ByValTStr, SizeConst:=MAX_PATH)> Public cFileName As String

    <VBFixedString(14), MarshalAs(UnmanagedType.ByValTStr, SizeConst:=14)> Public cAlternate As String

  End Structure

  Function StripNulls(ByRef OriginalStr As String) As String
    If (InStr(OriginalStr, Chr(0)) > 0) Then
      OriginalStr = VB.Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
    End If
    StripNulls = OriginalStr
  End Function

  Function FindFilesAPI(ByRef path As String, ByRef SearchStr As String, ByRef FileCount As Integer, ByRef DirCount As Integer) As Long
    Dim FileName As String ' Walking filename variable...

    Dim DirName As String ' SubDirectory Name
    Dim dirNames() As String ' Buffer for directory name entries
    Dim nDir As Integer = 0 ' Number of directories in this path

    Dim i As Long ' For-loop counter...

    Dim hSearchEx As Long 'Int32 ' Search Handle for FindFirstFileEx().
    Dim WFD As WIN32_FIND_DATA = Nothing 'Memory block
    Static Cont As Boolean 'Long

    FindFilesAPI = 0

    If VB.Right(path, 1) = "\" Then path = VB.Left(path, Len(path) - 1)

    'Search for subdirectories:
    nDir = 0
    ReDim dirNames(nDir)
    Cont = True

    'For the FindFirstFileEx() function:
    'Dim lpFileName As String = ".*"
    Dim fInfoLevelId As FINDEX_INFO_LEVELS = 0
    Dim lpFindFileData As WIN32_FIND_DATA = Nothing
    Dim fSearchOp As FINDEX_SEARCH_OPS = 0
    Dim lpSearchFilter As Int32 = Nothing
    Dim dwAdditionalFlags As Integer = 0    '1 = FIND_FIRST_EX_CASE_SENSITIVE, 2 = FIND_FIRST_EX_LARGE_FETCH (May not be supported in Win7)

    '--------------------------------------------------------------------------------------------------------------------------------------
    'Make pointers for the lpFileName string, and lpFindFileData structure, then execute API function:

    '-------------------------------------------------------------------------------------
    'For the string:

    Dim lpFileName_str As String = "\\?\UNC\" & path & "\*"

    'Initialize unmanged memory to hold the lpFileName string: 
    'Dim lpFileName_IntPtr As IntPtr = Marshal.AllocHGlobal(Marshal.SizeOf(lpFileName_str))
    Dim lpFileName_IntPtr As IntPtr = Marshal.StringToHGlobalAuto(lpFileName_str)
    '-------------------------------------------------------------------------------------
    'For the structure:

    Dim lpFindFileData_Original As WIN32_FIND_DATA = Nothing

    'Initialize unmanged memory to hold the struct: 
    Dim lpFindFileData_IntPtr As IntPtr = Marshal.AllocHGlobal(Marshal.SizeOf(lpFindFileData_Original))

    '-------------------------------------------------------------------------------------
    'Do folder/file search:

    Try
      'Copy the struct to unmanaged memory:
      Marshal.StructureToPtr(lpFindFileData_Original, lpFindFileData_IntPtr, False)
      hSearchEx = FindFirstFileExW(lpFileName_IntPtr, fInfoLevelId, lpFindFileData_IntPtr, fSearchOp, lpSearchFilter, dwAdditionalFlags)
      WFD = CType(Marshal.PtrToStructure(lpFindFileData_IntPtr, GetType(WIN32_FIND_DATA)), WIN32_FIND_DATA)

    Finally
      'Free the unmanaged memory for the string:
      Marshal.FreeHGlobal(lpFileName_IntPtr)

      'Free the unmanaged memory for the structure:
      Marshal.FreeHGlobal(lpFindFileData_IntPtr)
    End Try

    '-------------------------------------------------------------------------------------
    'Process folders:

    If hSearchEx <> INVALID_HANDLE_VALUE Then
      Do While Cont
        System.Windows.Forms.Application.DoEvents()

        DirName = StripNulls(WFD.cFileName)

        'Ignore the current and encompassing directories:
        If (DirName <> ".") And (DirName <> "..") And (DirName <> "") Then
          'Check for directory with bitwise comparison:

          Dim FileAttributes As Integer = GetFileAttributesW("\\?\UNC\" & path & "\" & DirName)

          If FileAttributes And FILE_ATTRIBUTE_DIRECTORY Then
            dirNames(nDir) = DirName
            DirCount = DirCount + 1
            nDir = nDir + 1
            ReDim Preserve dirNames(nDir)
            List1.Items.Add(path & "\" & DirName)
          End If
        End If

        Cont = FindNextFileW(hSearchEx, WFD) 'Get next subdirectory.

      Loop

      Cont = FindClose(hSearchEx)

      If Cont = False Then
        MsgBox("Error:  " + Str(GetLastError))
      End If

    End If

  End Function

  Private Sub Go_cmd_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Go_cmd.Click
    Dim SearchPath, FindStr As String
    Dim FileSize As Long
    Dim NumFiles, NumDirs As Long

    System.Windows.Forms.Cursor.Current = System.Windows.Forms.Cursors.WaitCursor

    List1.Items.Clear()
    SearchPath = Text1.Text
    FindStr = Text2.Text

    FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs)

    System.Windows.Forms.Cursor.Current = System.Windows.Forms.Cursors.Default

  End Sub

  Private Sub Quit_cmd_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Quit_cmd.Click
    End
  End Sub



End Class