您当前的位置: 湖南自考网 > 毕业论文 > 工学类 > 文章详情

湖南自考计算机专业本科论文 含子目录的搜寻档案

2018-07-24 14:36:10
来源:湖南自考网
标题:非递回、无使用界面的档案搜寻
一般来说,搜寻目录及子目录底下符合条件之所有档案功能的程式撰写,一向颇令人头疼,而最後的解决方式多用 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
TAG标签: 湖南     本科     论文    

湖南学历提升报名热线:0731-85718026快速联系通道  
甘老师QQ咨询 蒋老师QQ咨询 QQ咨询

TEL:甘老师18711294471 蒋老师17773102705 陈老师0731-85718026

2020年自考、成考、网教报名进行中,点击立即报考咨询>>

扫一扫下方二维码关注湖南自考生网微信公众号、客服咨询号,即时获取湖南自考、成考、网教最新考试资讯。

  • 湖南自考官方公众号

    关注公众号免费拿资料

  • 湖南自考官方微信

    微信扫一扫保过没烦恼

免责声明

1、鉴于各方面资讯时常调整与变化,本网所提供的信息仅供参考,实际以考试院通知文件为准。

2、本网部分内容来源于网络,如有内容、版权等问题请与本网联系,我们将会及时处理。联系方式 :QQ(2319172247)

3、如转载湖南自考生网声明为“原创”的内容,请注明出处及网址链接,违者必究!

特别声明:本站信息大部分来源于各高校,真实可靠!部分内容来自互联网,仅供参考!所有信息以实际政策和官方公告为准!

湖南求实创新教育科技有限公司 版权所有 湘ICP备18023047号-1