Solved

Speed Searching through Hard drive : vb6

Posted on 2004-09-27
8
275 Views
Last Modified: 2010-05-02
The  code below searches through the c:\ drive and when it finds filenames contained
in "C:\input.txt" it add them to a listbox.

problem is if i have to many filenames to search for or the "C:\input.txt" file is
large then the program crawls

i need to speed this code 1000% , its just too slow.





' command button , label , listbox


Dim fso As New FileSystemObject   ' Add microsoft scripting runtime reference
Dim fld As Folder
Const fsoForReading = 1

Private Sub Command1_Click()
   
    Dim nDirs As Long, nFiles As Long, lSize As Currency
    Dim sDir As String, sSrchString() As String
   
    Dim strInputFileName As String
    Dim objTextStream As TextStream

    Dim i As Integer
   
    sDir = "c:\"
     
   
    strInputFileName = "C:\input.txt"
   
    Set objTextStream = fso.OpenTextFile(strInputFileName, fsoForReading)
   

    ReDim Preserve sSrchString(i)
    Do While Not objTextStream.AtEndOfStream
        i = UBound(sSrchString) + 1
        ReDim Preserve sSrchString(i)
        sSrchString(i) = objTextStream.ReadLine
   
    Loop

    Label1.Caption = "Searching " & vbCrLf & UCase(sDir) & "..."
       
    lSize = FindFile(sDir, sSrchString, nDirs, nFiles)
       
    MsgBox Str(nFiles) & " files found in" & Str(nDirs) & " directories", vbInformation
    MsgBox "Total Size = " & lSize & " bytes"


End Sub

Private Function FindFile(ByVal sFol As String, sFile() As String, nDirs As Long, nFiles As Long) As Currency
   Dim tFld As Folder, tFil As File, FileName As String
   
   On Error GoTo Catch
   Set fld = fso.GetFolder(sFol)
   For i = 1 To UBound(sFile)
        FileName = Dir(fso.BuildPath(fld.Path, sFile(i)), vbNormal Or vbHidden Or vbSystem Or vbReadOnly)
        While Len(FileName) <> 0
           FindFile = FindFile + FileLen(fso.BuildPath(fld.Path, FileName))
           nFiles = nFiles + 1
           List1.AddItem fso.BuildPath(fld.Path, FileName)  ' Load ListBox
           FileName = Dir()  ' Get next file
           DoEvents
        Wend
   Next i
   Label1 = "Searching " & vbCrLf & fld.Path & "..."
   nDirs = nDirs + 1
   If fld.SubFolders.Count > 0 Then
      For Each tFld In fld.SubFolders
         DoEvents
         FindFile = FindFile + FindFile(tFld.Path, sFile, nDirs, nFiles)
      Next
   End If
   Exit Function
Catch:  FileName = ""
       Resume Next
End Function
0
Comment
Question by:Jimmyx1000
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 3
8 Comments
 
LVL 86

Expert Comment

by:Mike Tomlinson
ID: 12164853
You could try modifying the API FindFirstFile example from AllAPI:
http://www.mentalis.org/apilist/FindFirstFile.shtml

The example is at the bottom of the page:
http://www.mentalis.org/apilist/DAD43CF20ED09D1897B0ECAAF0BF86EE.html

~IM
0
 
LVL 1

Accepted Solution

by:
VBtorment earned 500 total points
ID: 12164936
Yo Jimmy
Here is a faster one, using api
and an aray for the info.txt
hope this work for ya :)

Private Const MAX_PATH = 260
   
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

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 FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Dim aFiles(0 To 100) As String 'number of files in your info.txt (use redim)
Dim iCount%

Private Sub ReadInfoTXT()
Dim sRow$
    'put all files in info.txt in a collection
    Open "C:\Info.txt" For Input As #1
        Do While Not EOF(1)
            Line Input #1, sRow$
            aFiles(iCount%) = sRow$
            iCount% = iCount% + 1
        Loop
    Close #1
End Sub

Private Function TrimNull(startstr As String) As String
Dim pos As Integer

    pos = InStr(startstr, Chr$(0))
    If pos Then
        TrimNull = Left$(startstr, pos - 1)
        Exit Function
    End If
     TrimNull = startstr
End Function

Private Function bsl(Path$) As String
'Always return backslash at end of string
    If Right$(Path$, 1) = "\" Then
        bsl = Path$
    Else
        bsl = Path$ & "\"
    End If
End Function

Sub CountFolders(sPath$)
Dim i%
Dim WFD As WIN32_FIND_DATA
Dim hFile As Long
Dim cont As Integer
Dim sFile As String
       
    cont = True
    sPath$ = bsl(sPath$)
    hFile = FindFirstFile(sPath & "*.*" & Chr$(0), WFD)
    If hFile <> -1 Then
        While cont
            sFile = TrimNull(WFD.cFileName)
            If (sFile <> ".") And (sFile <> "..") Then
                If (WFD.dwFileAttributes And vbDirectory) Then 'Folders
                    CountFolders sPath$ & sFile 'recurse
                Else    'files
                    For i% = 0 To iCount%
                        If UCase(aFiles(i%)) = UCase(sFile) Then
                            'Add to listbox here
                            List1.AddItem sPath & sFile
                        End If
                    Next
                End If
            End If
            cont = FindNextFile(hFile, WFD)
        Wend
    End If
    Call FindClose(hFile)
End Sub

Private Sub Form_Load()
    Show
    iCount% = 0
    ReadInfoTXT
    CountFolders "C:\"
End Sub
0
 

Author Comment

by:Jimmyx1000
ID: 12166242
VBtorment  ,

Hello Expert

VBtorment  ,can you tell me please

Where i can i add a label command so
i can actually see what is happening as the files are being searched.

VBtorment  ,thankyou



0
Salesforce Made Easy to Use

On-screen guidance at the moment of need enables you & your employees to focus on the core, you can now boost your adoption rates swiftly and simply with one easy tool.

 

Author Comment

by:Jimmyx1000
ID: 12166567
Vbtorment Good Work Well Done

I like the speed in your code , Good work

Vbtorment for an extra 500 points can you code me the pause and stop buttons
please.

Thanks Expert.

0
 
LVL 1

Expert Comment

by:VBtorment
ID: 12174589
Yo Jimmy

First for the label
 you can add it in the CountFolders sub (see below)

Sub CountFolders(sPath$)
...
...

               Else    'files
                   'Add Label here
                   Label1.caption=sPath$ & sFile
                   Doevents 'this is a must or else ya won't see a thing, but it will flikker the screen because this is fast!!
                    For i% = 0 To iCount%
                   ...
...
...
End sub
0
 
LVL 1

Expert Comment

by:VBtorment
ID: 12174638
Hai Jimmy

the pause button is a tricky one
i don't want to use it, but i don't know any other way...

use a boolean bWait (true/false) in a command button (bwait=not bwait)

At the top of the CountFolder sub add these lines

while bWait
    DoEvents
wend

this will hold the application as long as bWait = true
Remeber this is a tricky one (watch yor proccesor in the tasklist)
Maybe better ask another Expert for this :)
0
 

Author Comment

by:Jimmyx1000
ID: 12175144
thanks vbtorment

Good Work , Let me know how i can transfer more points to you .

0
 
LVL 1

Expert Comment

by:VBtorment
ID: 12177976
Thanks

but i don't know how you can do that, i'm new here :)
0

Featured Post

Salesforce Has Never Been Easier

Improve and reinforce salesforce training & adoption using WalkMe's digital adoption platform. Start saving on costly employee training by creating fast intuitive Walk-Thrus for Salesforce. Claim your Free Account Now

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
to transfer string from C lanaguage to VBA 4 79
How to make an ADE file by code? 11 101
Macro Excel - Multiple If conditions 2 88
Help me. 3 71
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

730 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question