Chinaunix首页 | 论坛 | 博客
  • 博客访问: 1799273
  • 博文数量: 600
  • 博客积分: 10581
  • 博客等级: 上将
  • 技术积分: 6205
  • 用 户 组: 普通用户
  • 注册时间: 2008-11-06 10:13
文章分类
文章存档

2016年(2)

2015年(9)

2014年(8)

2013年(5)

2012年(8)

2011年(36)

2010年(34)

2009年(451)

2008年(47)

分类:

2009-10-11 10:44:42

标题:非递归、无使用界面的文件搜寻

      一般来说,搜寻目录及子目录底下符合条件之所有文件功能的程式撰写,一向
颇令人头疼,而最后的解决方式多用 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
 
阅读(622) | 评论(0) | 转发(0) |
给主人留下些什么吧!~~