含子目錄的搜尋檔案

含子目錄的搜尋檔案

來源:cww, 老怪

以下是老怪兄所作的None Recursive的作法。感謝老怪提供的程式

標題：非遞迴、無使用界面的檔案搜尋

      一般來說，搜尋目錄及子目錄底下符合條件之所有檔案功能的程式撰寫，一向
頗令人頭疼，而最後的解決方式多用 Recursive(程式遞迴呼叫) 來解決，像 VB5.0
所附的 WinSeek.vbp 範例，就是 FileListBox 和 Recursive 程序的兼用，來解決
這個問題。

      本範例則用另一種思考模式切入，在不使用任何 OCX 及 Recursive 程序下利
用兩個非固定陣列變數及雙層 Do...Loop 迴圈解決這問題。本範例代表的含意是你
把這段 Code 搬到無使用者可視界面的 Module 及 Class 裏，一樣可以執行(程式裏
的 ListBox 及 MsgBox 只是為了解說方便而已，實際的資料已放入 FilePackage 這
個動態陣列裏，可以 Index 取用。)

      當然你不能拿 Windows95 提供的[尋找]功能的搜尋速度來要求本範例，因為
那根本是兩種不同的驅動方式，但我用 "c:\" 為搜尋啟始目錄，以 "*.*" 為條件來
與 VB5.0 的範例程式 WinSeek.vbp 相比，WinSeek.vbp 是 2 分鐘，我是 2.5 分鐘
。更值得一提的是，其實整個搜尋動作在 55 秒時已全部完成，剩下的時間都是用來
顯示 ListBox 資料。所以如果你的程式並不需要立即的顯示查詢結果，那麼本範例
將比 WinSeek.vbp 更適合你使用。

      最後如果你覺得本程式有任何錯誤或有改進的意見，請寫信給站長，站長會轉
信給我，在此先謝謝你了。

老怪  上


' Need a ListBox, CommandBox
Option Explicit

'宣告搜尋到的檔案的儲存陣列變數
Private FilePackage() As String

Private Sub Command1_Click()
'宣告存放目錄名稱儲存陣列變數
Dim DirPackage() As String
'存放檔案搜尋條件之字串
Dim SearchString As String
'接收 Dir() 傳回字串，並做為迴圈判斷的字串
Dim DirString As String
'I 目前搜尋目錄的指位器，J 是 DirPackage 目錄陣列之上限指標
'K 是 FilePackage 之檔案陣列之上限指標
Dim I As Long, J As Long, K As Long

    '把 ListBox 的舊顯示資料清掉
    List1.Clear

    '把 FilePackage 的上一次搜尋資料清掉
    Erase FilePackage

    '假設我們的搜尋從 C 碟根目錄開始
    ReDim DirPackage(0)
    '路徑結尾一定要加 "\"
    DirPackage(0) = "c:\"

    '假設我們的搜尋字串是 "*.exe"
    SearchString = "*.exe"

    '顯示沙漏指標
    Me.MousePointer = 11

'-------- 以下搜尋 C 碟裏所有的目錄 -----------------

    '直到目錄指位器 I 超過目錄上限指標 J 才結束搜尋
    Do While I <= J

        '搜尋目錄指位器 I 所指的目錄
        DirString = Dir(DirPackage(I), vbHidden Or vbDirectory Or vbReadOnly Or vbSystem)

        '直到目前目錄找不到任何目錄或檔案才結束
        Do While DirString <> ""

            '不要把上層目錄和現目錄的指標符號算進去
            If DirString <> "." And DirString <> ".." Then

                '如果找到的是個目錄
                If (GetAttr(DirPackage(I) & DirString) And vbDirectory) _
                        = vbDirectory Then
                    '把目錄上限加 1
                    J = J + 1
                    '把儲存目錄名稱的陣列加一個
                    ReDim Preserve DirPackage(J)
                    '把查到的新目錄放在 DirPackage 新元素裏
                    DirPackage(J) = DirPackage(I) + DirString + "\"

                '如果找到的是個檔案
                Else
                    '如果與搜尋字串相符合
                    If UCase(DirString) Like UCase(SearchString) Then
                        '把儲存檔案名稱的陣列加一個
                        ReDim Preserve FilePackage(K)
                        '把查到的新檔案放在 filePackage 新元素裏
                        FilePackage(K) = DirPackage(I) + DirString
                        '把檔案上限加 1
                        K = K + 1
                    End If
                End If

            End If

            '繼續找是否有符合的資料，並把結果放 DirString 裏
            DirString = Dir
            DoEvents
        Loop

        '把現目錄指標往下移一個
        I = I + 1
    Loop

'-------- 以下將結果輸出到列示盒裏  -----------------


'-------- 以下為找到檔案之總計  -----------------


    '還原滑鼠指標
    Me.MousePointer = 0

    If K = 0 Then
        MsgBox "沒有 " & SearchString & " 的檔案"
    Else
        '以下將結果輸出到列示盒裏
        For I = 0 To UBound(FilePackage)
            List1.AddItem FilePackage(I)
            DoEvents
        Next

        MsgBox "總共找到 " & UBound(FilePackage) + 1 & " 個檔案"

    End If

End Sub

以下有Recursive作法，本人測試發現Recursive的作法略快一些，原因可能出在ReDim Preserve DirPackage與 ReDim Preserve sDirectoryList上，前者一直動態新增目錄字串(如果c:\之下含目錄下的子目錄一共100個，那這個陣列便會有100的大小)，而後者Recursive的作法則不同，它動態目錄的最大值則是含有最大子目錄數的那個目錄中，子目錄之數目(如：c:\windows中含最多子目錄，其子目錄有30 個，且這30個是不含子目錄下的子目錄，則動態字串陣列的最大個數便只有30)

' Need a CommandBox
Private FoundFile() as String '存放傳回值的字串陣列
Private ntx As Long

Private Sub Command1_Click()
ntx = 0
Call GetDirPath("c:\", "*.ini")
End Sub

Private Sub GetDirPath(CurrentPath As String, ByVal SearFile As String)
    Dim nI As Integer, nDirectory As Integer, i As Long
    Dim sFileName As String, sDirectoryList() As String
    'First list all normal files in this directory
    sFileName = Dir(CurrentPath, vbHidden Or vbDirectory Or vbReadOnly Or vbSystem)
    Do While sFileName <> ""
       If UCase(sFileName) Like UCase(SearFile) Then
          i = GetAttr(CurrentPath + sFileName)
          If (i And vbDirectory) = 0 Then
              ReDim Preserve FoundFile(ntx)
              FoundFile(ntx) = CurrentPath + sFileName
              ntx = ntx + 1
          End If
       End If
       If sFileName <> "." And sFileName <> ".." Then
           'Ignore nondirectories
          If GetAttr(CurrentPath & sFileName) _
                  And vbDirectory Then

             nDirectory = nDirectory + 1
             ReDim Preserve sDirectoryList(nDirectory)
             sDirectoryList(nDirectory) = CurrentPath & sFileName
            End If
        End If
       sFileName = Dir
    Loop
    'Recursively process each directory
     For nI = 1 To nDirectory
         GetDirPath sDirectoryList(nI) & "\", SearFile
     Next nI
End Sub

以下是老怪兄所作的None Recursive的作法。感謝老怪提供的程式

標題：非遞迴、無使用界面的檔案搜尋

      一般來說，搜尋目錄及子目錄底下符合條件之所有檔案功能的程式撰寫，一向
頗令人頭疼，而最後的解決方式多用 Recursive(程式遞迴呼叫) 來解決，像 VB5.0
所附的 WinSeek.vbp 範例，就是 FileListBox 和 Recursive 程序的兼用，來解決
這個問題。

      本範例則用另一種思考模式切入，在不使用任何 OCX 及 Recursive 程序下利
用兩個非固定陣列變數及雙層 Do...Loop 迴圈解決這問題。本範例代表的含意是你
把這段 Code 搬到無使用者可視界面的 Module 及 Class 裏，一樣可以執行(程式裏
的 ListBox 及 MsgBox 只是為了解說方便而已，實際的資料已放入 FilePackage 這
個動態陣列裏，可以 Index 取用。)

      當然你不能拿 Windows95 提供的[尋找]功能的搜尋速度來要求本範例，因為
那根本是兩種不同的驅動方式，但我用 "c:\" 為搜尋啟始目錄，以 "*.*" 為條件來
與 VB5.0 的範例程式 WinSeek.vbp 相比，WinSeek.vbp 是 2 分鐘，我是 2.5 分鐘
。更值得一提的是，其實整個搜尋動作在 55 秒時已全部完成，剩下的時間都是用來
顯示 ListBox 資料。所以如果你的程式並不需要立即的顯示查詢結果，那麼本範例
將比 WinSeek.vbp 更適合你使用。

      最後如果你覺得本程式有任何錯誤或有改進的意見，請寫信給站長，站長會轉
信給我，在此先謝謝你了。

老怪  上


' Need a ListBox, CommandBox
Option Explicit

'宣告搜尋到的檔案的儲存陣列變數
Private FilePackage() As String

Private Sub Command1_Click()
'宣告存放目錄名稱儲存陣列變數
Dim DirPackage() As String
'存放檔案搜尋條件之字串
Dim SearchString As String
'接收 Dir() 傳回字串，並做為迴圈判斷的字串
Dim DirString As String
'I 目前搜尋目錄的指位器，J 是 DirPackage 目錄陣列之上限指標
'K 是 FilePackage 之檔案陣列之上限指標
Dim I As Long, J As Long, K As Long

    '把 ListBox 的舊顯示資料清掉
    List1.Clear

    '把 FilePackage 的上一次搜尋資料清掉
    Erase FilePackage

    '假設我們的搜尋從 C 碟根目錄開始
    ReDim DirPackage(0)
    '路徑結尾一定要加 "\"
    DirPackage(0) = "c:\"

    '假設我們的搜尋字串是 "*.exe"
    SearchString = "*.exe"

    '顯示沙漏指標
    Me.MousePointer = 11

'-------- 以下搜尋 C 碟裏所有的目錄 -----------------

    '直到目錄指位器 I 超過目錄上限指標 J 才結束搜尋
    Do While I <= J

        '搜尋目錄指位器 I 所指的目錄
        DirString = Dir(DirPackage(I), vbHidden Or vbDirectory Or vbReadOnly Or vbSystem)

        '直到目前目錄找不到任何目錄或檔案才結束
        Do While DirString <> ""

            '不要把上層目錄和現目錄的指標符號算進去
            If DirString <> "." And DirString <> ".." Then

                '如果找到的是個目錄
                If (GetAttr(DirPackage(I) & DirString) And vbDirectory) _
                        = vbDirectory Then
                    '把目錄上限加 1
                    J = J + 1
                    '把儲存目錄名稱的陣列加一個
                    ReDim Preserve DirPackage(J)
                    '把查到的新目錄放在 DirPackage 新元素裏
                    DirPackage(J) = DirPackage(I) + DirString + "\"

                '如果找到的是個檔案
                Else
                    '如果與搜尋字串相符合
                    If UCase(DirString) Like UCase(SearchString) Then
                        '把儲存檔案名稱的陣列加一個
                        ReDim Preserve FilePackage(K)
                        '把查到的新檔案放在 filePackage 新元素裏
                        FilePackage(K) = DirPackage(I) + DirString
                        '把檔案上限加 1
                        K = K + 1
                    End If
                End If

            End If

            '繼續找是否有符合的資料，並把結果放 DirString 裏
            DirString = Dir
            DoEvents
        Loop

        '把現目錄指標往下移一個
        I = I + 1
    Loop

'-------- 以下將結果輸出到列示盒裏  -----------------


'-------- 以下為找到檔案之總計  -----------------


    '還原滑鼠指標
    Me.MousePointer = 0

    If K = 0 Then
        MsgBox "沒有 " & SearchString & " 的檔案"
    Else
        '以下將結果輸出到列示盒裏
        For I = 0 To UBound(FilePackage)
            List1.AddItem FilePackage(I)
            DoEvents
        Next

        MsgBox "總共找到 " & UBound(FilePackage) + 1 & " 個檔案"

    End If

End Sub