免费注册|会员登录 |小说|电影|文章|意见|帮助|收藏
交友中心 同城约会 交友圈子 博客日记 在线聊天 社区论坛
搜索中心 | 知心朋友 | 婚姻恋爱 | 亲密交友 | 会员相册 | 诚信会员 | 征婚宣言 | 浪漫宣言 | 成功故事
含子目录的搜寻档案
     
相关链接

含子目录的搜寻档案

■ 佚名

标题:非递回、无使用界面的档案搜寻
一般来说,搜寻目录及子目录底下符合条件之所有档案功能的程式撰写,一向颇令人头疼,而最後的解决方式多用 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


上一篇     下一篇