find files -> alter code ? chrisjk

[Dutch]

this " find files " code was posted by chrisjk , it works great but i would like to use this code to find a specific file format , say i wanna find only Mp3's or whatever , how would i alter the code to do that ? also , what do i change so it doesn't search in the recycle bin anymore ?

thanx.

'Create a form with a command button (command1), a list box (list1)
'and four text boxes (text1, text2, text3 and text4).
'Type in the first textbox a startingpath like c:\
'and in the second textbox you put a pattern like *.* or *.txt

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
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
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Const MAX_PATH = 260
Const MAXDWORD = &HFFFF
Const INVALID_HANDLE_VALUE = -1
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

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

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
Function StripNulls(OriginalStr As String) As String
    If (InStr(OriginalStr, Chr(0)) > 0) Then
        OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
    End If
    StripNulls = OriginalStr
End Function

Function FindFilesAPI(path As String, SearchStr As String, FileCount As Integer, DirCount As Integer)
    'KPD-Team 1999
    'E-Mail: [email protected]
    'URL: http://www.allapi.net/

    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 ' Number of directories in this path
    Dim i As Integer ' For-loop counter...
    Dim hSearch As Long ' Search Handle
    Dim WFD As WIN32_FIND_DATA
    Dim Cont As Integer
    If Right(path, 1) <> "\" Then path = path & "\"
    ' Search for subdirectories.
    nDir = 0
    ReDim dirNames(nDir)
    Cont = True
    hSearch = FindFirstFile(path & "*", WFD)
    If hSearch <> INVALID_HANDLE_VALUE Then
        Do While Cont
        DirName = StripNulls(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
    ' Walk through this directory and sum file sizes.
    hSearch = FindFirstFile(path & SearchStr, WFD)
    Cont = True
    If hSearch <> INVALID_HANDLE_VALUE Then
        While Cont
            FileName = StripNulls(WFD.cFileName)
            If (FileName <> ".") And (FileName <> "..") Then
                FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow
                FileCount = FileCount + 1
                List1.AddItem path & FileName
            End If
            Cont = FindNextFile(hSearch, WFD) ' Get next file
        Wend
        Cont = FindClose(hSearch)
    End If
    ' If there are sub-directories...
    If nDir > 0 Then
        ' Recursively walk into them...
        For i = 0 To nDir - 1
            FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) & "\", SearchStr, FileCount, DirCount)
        Next i
    End If
End Function
Sub Command1_Click()
    Dim SearchPath As String, FindStr As String
    Dim FileSize As Long
    Dim NumFiles As Integer, NumDirs As Integer
    Screen.MousePointer = vbHourglass
    List1.Clear
    SearchPath = Text1.Text
    FindStr = Text2.Text
    FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs)
    Text3.Text = NumFiles & " Files found in " & NumDirs + 1 & " Directories"
    Text4.Text = "Size of files found under " & SearchPath & " = " & Format(FileSize, "#,###,###,##0") & " Bytes"
    Screen.MousePointer = vbDefault
End Sub

[Skitchen8]

http://forums.vb-world.net/showthrea...ight=skitchen8 i asked the very same question, but as to the recycle bin i have no idea

[Dutch]

so i noticed , guess u don't know how to make that code search for 1 exact file huh

[chrisjk]

if you follow the directions, you'll see you need to add 4 textboxes...in the second one, type the exact filename you want.

If you only want to search for mp3s, put "*.mp3" in text2

[Dutch]

i understand that chrisjk , but i want the second textbox out , so the search is for one specific file , ie its for a program i made that only replace's one exact file , so there is no need to search for other files . and how do i alter the code to skip the recycle bin ?

[chrisjk]

Make these changes then

Sub Command1_Click()
    Dim SearchPath As String, FindStr As String
    Dim FileSize As Long
    Dim NumFiles As Integer, NumDirs As Integer
    Screen.MousePointer = vbHourglass
    List1.Clear
    [b]SearchPath = "C:\"[/b]
    [b]FindStr = "*.mp3"[/b]
    FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs)
    Text3.Text = NumFiles & " Files found in " & NumDirs + 1 & " Directories"
    Text4.Text = "Size of files found under " & SearchPath & " = " & Format(FileSize, "#,###,###,##0") & " Bytes"
    Screen.MousePointer = vbDefault
End Sub

As for ignoring the recycle in, this is the modified FindFiles function

Function FindFilesAPI(path As String, SearchStr As String, FileCount As Integer, DirCount As Integer)
 
    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 ' Number of directories in this path
    Dim i As Integer ' For-loop counter...
    Dim hSearch As Long ' Search Handle
    Dim WFD As WIN32_FIND_DATA
    Dim Cont As Integer
    If Right(path, 1) <> "\" Then path = path & "\"
    ' Search for subdirectories.
    nDir = 0
    ReDim dirNames(nDir)
    Cont = True
    hSearch = FindFirstFile(path & "*", WFD)
    If hSearch <> INVALID_HANDLE_VALUE Then
        Do While Cont
        DirName = StripNulls(WFD.cFileName)
        ' Ignore the current and encompassing directories.
        If (DirName <> ".") And (DirName <> "..") And InStr(1, DirName, "RECYCLE") < 1 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
    ' Walk through this directory and sum file sizes.
    hSearch = FindFirstFile(path & SearchStr, WFD)
    Cont = True
    If hSearch <> INVALID_HANDLE_VALUE Then
        While Cont
            FileName = StripNulls(WFD.cFileName)
            If (FileName <> ".") And (FileName <> "..") Then
                FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow
                FileCount = FileCount + 1
                List1.AddItem path & FileName
            End If
            Cont = FindNextFile(hSearch, WFD) ' Get next file
        Wend
        Cont = FindClose(hSearch)
    End If
    ' If there are sub-directories...
    If nDir > 0 Then
        ' Recursively walk into them...
        For i = 0 To nDir - 1
            FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) & "\", SearchStr, FileCount, DirCount)
        Next i
    End If
End Function

[Nucleus]

My guess is that find files doesn't scan any vitual folders at all, it doesn't just skip the recycle bin, which makes its performance much faster.

[Dutch]

works like a charm thanks ,,

[chrisjk]

What OS are you on? I tested it under 2k (where the recycle bin is C:\Recycler). Can't remeber if that is the same under 98/95.

[Dutch]

SearchPath = "C:\"
FindStr = "*.mp3"


can the SearchPath use a drivelistbox ?
looks much better with a drivelistbox then a textbox imho

i'm using win 98 SE btw.

[chrisjk]

Originally posted by Dutch
SearchPath = "C:\"
FindStr = "*.mp3"


can the SearchPath use a drivelistbox ?
looks much better with a drivelistbox then a textbox imho

Yes...

SearchPath = Drive1.Drive

[Dutch]

ok , i should have figured that myself , sorry to say tho , the drive1.drive doesn't work , well not with the search file code that is

[chrisjk]

Sorry, it should be this

Drive1.Drive & "\"

[Dutch]

doesn't work , strange huh

[Skitchen8]

it should, drive1.drive should return something such as "C:" and adding the "\" to it should make it "C:\"

[Dutch]

it doesn't return anything , not even a error

[Skitchen8]

ok, do msgbox drive1.drive and see what it says, or paste this code in

debug.? drive1.drive

[Dutch]

with ? drive1.drive it says compile error

[Skitchen8]

i changed it, try again... ? is print so i had to do debug.? to make it work, that will print it into the immediate window

[Dutch]

still a compile error "expected expression"

[Skitchen8]

did you make sure you have a drive list box named drive1??

[Dutch]

yeah , i am

Sub Command1_Click()
    Dim SearchPath As String, FindStr As String
    Dim FileSize As Long
    Dim NumFiles As Integer, NumDirs As Integer
    Screen.MousePointer = vbHourglass
    List1.Clear
    SearchPath = Drive1.Drive & "\"
    FindStr = "*.mp3"
    FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs)
    Screen.MousePointer = vbDefault
End Sub

and its called Drive1 in the properties screen too , so that should be ok then huh

[Dutch]

i don't get it , as soon as i use a textbox again , it works , but it doesn't work with a drivelistbox and Drive1.Drive ? is there a line in the code that points to a textbox ? if there is i don't see it.

[chrisjk]

Here is a tested working demo

[Dutch]

crap , now i'm really confused , that demo program doesn't work on my computer , i get no errors , but the program just doesn't search , it doesn't do anything when i run it .

this must have something to do with my computer
if it works ok for you.
i replaced the drivelist box in that demo for a textbox
and edited the SearchPath to Text1.Text and now it
works again.

[Dutch]

when i change

SearchPatch = Drive1.Drive & "\"
FindStr = "*.mp3"

to this

SearchPatch = Drive1.Drive & "\"
FindStr = "*.*"

it finds every single file , how come when i wanna search
for *.mp3 it doesn't work ??

[Skitchen8]

try MP3 maybe

[chrisjk]

Originally posted by Dutch
it finds every single file , how come when i wanna search
for *.mp3 it doesn't work ??

Are you sure you actually have mp3s on that drive?

Does it appear to be searching, but not display anything, or just not searching at all.

[Dutch]

yes , i'm sure there are mp3's on that drive , but it doesn't matter
file format i try to look for , it only works with *.* and it leaves me
clueless why it does that. i can click the button and nothing happens . nothing at all , no hourglass , no error , nothing.

[chrisjk]

Well I'm at a loss. Without having your computer I couldn't possibly work out why it works great on this, but not yours.

[Dutch]

well i guess i have to use a textbox then , and not a fancy drivelistbox , i'll make the program with a drivelistbox anyway and let others test it.

[chrisjk]

I tested it on a Win98SE system, works like a charm

[Dutch]

i honestly don't know why it doesn't work for me , i know that it sux tho not your demo program and not my program works when i use a drivelistbox , only works with textbox in which i have to type C:\

[NotLKH]

Hmm,

Does this help any?

Private Sub Command1_Click()
Dim Find_What As String
Dim Start_Where As String
Dim SKIP_THIS As String
SKIP_THIS = "C:\RECYCLED" '''Your Recycle bin
Find_What = "*.mp3"  '''What you want to find
Start_Where = "c:\"   '''Your initial directory
List1.Clear
Call FIND_IT(Start_Where, Find_What, SKIP_THIS)
End Sub
 
 
Private Sub FIND_IT(ByVal M_Where As String, ByVal M_What As String, ByVal Skip_What As String)
Dim MY_DIRS() As String
Dim MY_COUNT As Integer '
MY_COUNT = 0
ReDim MY_DIRS(1)
 
If Right(M_Where, 1) <> "\" Then
    M_Where = M_Where & "\"
End If
 
doiexist = Dir(M_Where & "*.*", vbDirectory)
While doiexist <> ""
    If doiexist <> "." And doiexist <> ".." Then
        If (GetAttr(M_Where & doiexist) And vbDirectory) = vbDirectory Then
            MY_COUNT = MY_COUNT + 1
            ReDim Preserve MY_DIRS(MY_COUNT)
            MY_DIRS(MY_COUNT) = M_Where & doiexist
            Form1.Caption = MY_COUNT
            DoEvents
        End If
    End If
    doiexist = Dir
Wend
If Left(M_Where, Len(Skip_What) + 1) <> Skip_What & "\" Then
    doiexist = Dir(M_Where & M_What, vbNormal)
    While doiexist <> ""
        List1.AddItem M_Where & doiexist
        doiexist = Dir
    Wend
End If
For Each Thing In MY_DIRS
    If Thing <> "" Then
        Call FIND_IT(Thing, M_What, Skip_What)
    End If
Next Thing
End Sub

-Lou

[Dutch]

i guess this is good too , but i want to be able to
search on any drive , not juts C:\ , and i can't
figure out why a drivelistbox doesn't work , i have
send my program and the demo from Chrisjk to
several people and they all say it don't work with
a drivelistbox.
but anyhow , thanks for trying to help me out

[Dutch]

btw notLKH , very nice code , and very fast ! thanks i'm gonna
save this , might be of use someday

again if i enter a textbox and change the code to this

Start_Where = Text1.Text '''Your initial directory

i can then type in any drive and do a search , if i change it
to this

Start_Where = Drive1.Drive & "\" '''Your initial directory

the drivebox don't work

[chrisjk]

Why not do this, so when a drive is selected, it puts it into the textbox (which you can hide)

Private Sub Drive1_Change()
 
Text1.Text = Drive1.Drive & "\"
 
End Sub

That's the only solution I can think of.

[Dutch]

this doesn't work for me , man , do i have a stubborn computer or what ??

[chrisjk]

must be

[Dutch]

well , i used the "GetDriveTypeA" example from the MS
knowledge base , and it sees all my drive's , i guess
my program doesn't activate the drives , if that is even
possible