含子目录的搜寻档案 -电脑资料

电脑资料 时间:2019-01-01 我要投稿
【www.unjs.com - 电脑资料】

   

    搜寻目录及子目录底下符合条件之所有档案功能的程式撰写,一向颇令人头疼,而最後的解决方式多用 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

   

最新文章