Option Explicit On
Option Strict On
Option Compare Text
Imports System.Runtime.InteropServices
Imports Microsoft.VisualBasic.ControlChars
Imports System.IO
Public Class Form1
Inherits System.Windows.Forms.Form
<DllImport("kernel32", CharSet:=CharSet.Unicode, SetLastError:=False)> _
Private Shared Function FindClose _
(ByVal hFindFile As Integer) As Integer
End Function
<DllImport("kernel32", CharSet:=CharSet.Unicode, SetLastError:=True)> _
Private Shared Function FindFirstFileW _
(ByVal lpFileName As String, ByVal lpFindFileData As WIN32_FIND_DATA) As Integer
End Function
<DllImport("kernel32", CharSet:=CharSet.Unicode, SetLastError:=True)> _
Private Shared Function FindNextFileW _
(ByVal hFindFile As Integer, ByVal lpFindFileData As WIN32_FIND_DATA) As Integer
End Function
<DllImport("user32", CharSet:=CharSet.Unicode, SetLastError:=False)> _
Private Shared Function SendMessage _
(ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByRef lParam As Integer) As Integer
End Function
Private Structure FILETIME
Dim dwLowDateTime As Integer
Dim dwHighDateTime As Integer
End Structure
Private Const ALTERNATE As Integer = 14
Private Const FILE_ATTRIBUTE_DIRECTORY As Integer = &H10S
Private Const INVALID_HANDLE_VALUE As Integer = -1
Private Const MAX_PATH As Integer = 260
Private Const LB_GETCOUNT As Integer = &H18BS
Private Const LB_SETHORIZONTALEXTENT As Short = &H194S
Private Const LB_SETTOPINDEX As Integer = &H197S
<Serializable(), StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)> _
Private Structure WIN32_FIND_DATA
Dim dwFileAttributes As FileAttributes
Dim ftCreationTime As FILETIME
Dim ftLastAccessTime As FILETIME
Dim ftLastWriteTime As FILETIME
Dim nFileSizeHigh As Integer
Dim nFileSizeLow As Integer
Dim dwReserved0 As Integer
Dim dwReserved1 As Integer
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=MAX_PATH)> _
Dim cFileName As String
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=ALTERNATE)> _
Dim cAlternate As String
End Structure
Private Sub frmFindFirstFile_Activated(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Activated
With lstStuff
UPGRADE_ISSUE: Constant vbPixels was not upgraded. Click for more: ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2070"
UPGRADE_ISSUE: Constant vbTwips was not upgraded. Click for more: ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2070"
UPGRADE_ISSUE: Form method frmWFDTest.ScaleX was not upgraded. Click for more: ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"
SendMessage(.Handle.ToInt32, LB_SETHORIZONTALEXTENT, ScaleX(VB6.PixelsToTwipsX(.Width), vbTwips, vbPixels) + 5000, 0)
End With
End Sub
Private Sub btnRunMe_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnRunMe.Click
Dim lngCount As Integer
Dim sFileName As String
sFileName = txtDriveLetter.Text & ":\" Can be up to 32,767 chars
lstStuff.Items.Clear()
lngCount = 0
FindMyFiles(sFileName, lngCount)
End Sub
Private Sub FindMyFiles(ByRef Path As String, ByRef lngFileCount As Integer)
Dim k As Integer
Dim NumberDirectories As Integer
Dim strListDirectoryNames() As String
The following can be Static or Private
Dim Filename As String
Dim hSearch As Integer
Dim WFD As WIN32_FIND_DATA
NumberDirectories = -1
hSearch = FindFirstFileW(StrPtr(Path & "*"), VarPtr(WFD))
hSearch = FindFirstFileW(Path & "*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
With txtProcessed
Do
System.Windows.Forms.Application.DoEvents()
Filename = RemoveNulls(WFD.cFileName)
If (Filename <> ".") And (Filename <> "..") Then
If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = 0 Then
lngFileCount = lngFileCount + 1
.Text = FormatNumber(lngFileCount, 0, , , TriState.True)
With lstStuff
.AddItem lngFileCount & ": " & Path & Filename
k = SendMessage(.hwnd, LB_GETCOUNT, ByVal 0&, ByVal 0&)
SendMessage .hwnd, LB_SETTOPINDEX, k - 1, ByVal 0&
End With
Else
NumberDirectories = NumberDirectories + 1
ReDim Preserve strListDirectoryNames(NumberDirectories)
strListDirectoryNames(NumberDirectories) = Filename
End If
End If
Loop While FindNextFileW(hSearch, VarPtr(WFD)) <> 0
Loop While FindNextFileW(hSearch, WFD) <> 0
End With
k = FindClose(hSearch)
End If
If NumberDirectories <> -1 Then
For k = 0 To NumberDirectories
FindMyFiles(Path & strListDirectoryNames(k) & "\", lngFileCount)
Next k
End If
End Sub
Private Function RemoveNulls(ByRef OriginalString As String) As String
Dim pos As Integer
pos = InStr(OriginalString, Chr(0))
If pos > 1 Then
RemoveNulls = Mid(OriginalString, 1, pos - 1)
Else
RemoveNulls = OriginalString
End If
End Function
End Class
