📄 m58.htm
字号:
<html>
<head>
<title>VB教程</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
</head>
<p align="center"><script src="../../1.js"></script></a>
<body bgcolor="#ffffff" leftmargin="5" topmargin="1" marginheight="5" marginwidth="5">
<div align=center>
<table border=0 cellpadding=0 cellspacing=0 width=680 align="center">
<tbody>
<tr>
<td width=200 height="59">
<div align="center">
</td>
<td colspan=2 valign=baseline height="59">
<div align=center><script language="JavaScript" src="../../ad/ads_b.asp">
</script>
<br>
</div>
</td>
</tr>
<tr align=middle valign=top>
<td width=200>
</td>
<td width=295>
</td>
<td width=185> </td>
</tr>
</tbody>
</table>
<table border=1 bordercolordark=#000000 bordercolorlight=#000000 cellpadding=0
cellspacing=0 width=567 align="center" height="128">
<tbody>
<tr>
<td bgcolor=#000000 height=9>
<div align=center class=H1> 含子目录的搜寻档案</font> </font> </font></div>
</td>
</tr>
<tr valign=top>
<td class=H1 height=76>
<p> <font color="#000000">以下是老怪兄所作的None
Recursive的作法。感谢老怪提供的程式 </font></span></font></p>
<p> 标题：非递回、无使用界面的档案搜寻<br>
<br>
一般来说，搜寻目录及子目录底下符合条件之所有档案功能的程式撰写，一向颇令人头疼，而最後的解决方式多用 Recursive(程式递回呼叫)
来解决，像 VB5.0所附的 WinSeek.vbp 范例，就是 FileListBox 和 Recursive 程序的兼用，来解决这个问题。<br>
<br>
本范例则用另一种思考模式切入，在不使用任何 OCX 及 Recursive 程序下利用两个非固定阵列变数及双层 Do...Loop 回圈解决这问题。本范例代表的含意是你把这段
Code 搬到无使用者可视界面的 Module 及 Class 里，一样可以执行(程式里的 ListBox 及 MsgBox 只是为了解说方便而已，实际的资料已放入
FilePackage 这个动态阵列里，可以 Index 取用。)<br>
<br>
当然你不能拿 Windows95 提供的[寻找]功能的搜寻速度来要求本范例，因为那根本是两种不同的驱动方式，但我用 "c:\" 为搜寻启始目录，以
"*.*" 为条件来与 VB5.0 的范例程式 WinSeek.vbp 相比，WinSeek.vbp 是 2 分钟，我是 2.5 分钟。更值得一提的是，其实整个搜寻动作在
55 秒时已全部完成，剩下的时间都是用来显示 ListBox 资料。所以如果你的程式并不需要立即的显示查询结果，那麽本范例<br>
将比 WinSeek.vbp 更适合你使用。<br>
<br>
最後如果你觉得本程式有任何错误或有改进的意见，请写信给站长，站长会转信给我，在此先谢谢你了。<br>
<br>
老怪 上 <br>
</font></span></font> </p>
<table border=0 width="696">
<tbody>
<tr>
<td> <font color="#000000" class="unnamed1">' Need a ListBox, CommandBox<br>
Option Explicit<br>
<br>
'宣告搜寻到的档案的储存阵列变数<br>
Private FilePackage() As String<br>
<br>
Private Sub Command1_Click()<br>
'宣告存放目录名称储存阵列变数<br>
Dim DirPackage() As String<br>
'存放档案搜寻条件之字串<br>
Dim SearchString As String<br>
'接收 Dir() 传回字串，并做为回圈判断的字串<br>
Dim DirString As String<br>
'I 目前搜寻目录的指位器，J 是 DirPackage 目录阵列之上限指标<br>
'K 是 FilePackage 之档案阵列之上限指标<br>
Dim I As Long, J As Long, K As Long<br>
<br>
'把 ListBox 的旧显示资料清掉<br>
List1.Clear<br>
<br>
'把 FilePackage 的上一次搜寻资料清掉<br>
Erase FilePackage<br>
<br>
'假设我们的搜寻从 C 碟根目录开始<br>
ReDim DirPackage(0)<br>
'路径结尾一定要加 "\"<br>
DirPackage(0) = "c:\"<br>
<br>
'假设我们的搜寻字串是 "*.exe"<br>
SearchString = "*.exe"<br>
<br>
'显示沙漏指标<br>
Me.MousePointer = 11<br>
<br>
'-------- 以下搜寻 C 碟里所有的目录 -----------------<br>
<br>
'直到目录指位器 I 超过目录上限指标 J 才结束搜寻<br>
Do While I <= J<br>
<br>
'搜寻目录指位器 I 所指的目录<br>
DirString = Dir(DirPackage(I), vbHidden Or vbDirectory Or vbReadOnly
Or vbSystem)<br>
<br>
'直到目前目录找不到任何目录或档案才结束<br>
Do While DirString <> ""<br>
<br>
'不要把上层目录和现目录的指标符号算进去<br>
If DirString <> "." And DirString <> ".." Then<br>
<br>
'如果找到的是个目录<br>
If (GetAttr(DirPackage(I) & DirString) And vbDirectory) _<br>
= vbDirectory Then<br>
'把目录上限加 1<br>
J = J + 1<br>
'把储存目录名称的阵列加一个<br>
ReDim Preserve DirPackage(J)<br>
'把查到的新目录放在 DirPackage 新元素里<br>
DirPackage(J) = DirPackage(I) + DirString + "\"<br>
<br>
'如果找到的是个档案<br>
Else<br>
'如果与搜寻字串相符合<br>
If UCase(DirString) Like UCase(SearchString) Then<br>
'把储存档案名称的阵列加一个<br>
ReDim Preserve FilePackage(K)<br>
'把查到的新档案放在 filePackage 新元素里<br>
FilePackage(K) = DirPackage(I) + DirString<br>
'把档案上限加 1<br>
K = K + 1<br>
End If<br>
End If<br>
<br>
End If<br>
<br>
'继续找是否有符合的资料，并把结果放 DirString 里<br>
DirString = Dir<br>
DoEvents<br>
Loop<br>
<br>
'把现目录指标往下移一个<br>
I = I + 1<br>
Loop<br>
<br>
'-------- 以下将结果输出到列示盒里 -----------------<br>
<br>
<br>
'-------- 以下为找到档案之总计 -----------------<br>
<br>
<br>
'还原滑鼠指标<br>
Me.MousePointer = 0<br>
<br>
If K = 0 Then<br>
MsgBox "没有 " & SearchString & " 的档案"<br>
Else<br>
'以下将结果输出到列示盒里<br>
For I = 0 To UBound(FilePackage)<br>
List1.AddItem FilePackage(I)<br>
DoEvents<br>
Next<br>
<br>
MsgBox "总共找到 " & UBound(FilePackage) + 1 & " 个档案"<br>
<br>
End If<br>
<br>
End Sub</font><br>
</td>
</tr>
</tbody>
</table>
<span class="unnamed1">以下有Recursive作法，本人测试发现Recursive的作法略快一些，
原因可能出在ReDim Preserve DirPackage与 ReDim Preserve sDirectoryList上， 前者一直动态新增目录字串(如果c:\之下含目录下的子目录一共100个，那这个阵列便
会有100的大小)，而後者Recursive的作法则不同，它动态目录的最大值则是含有最大 子目录数的那个目录中，子目录之数目(如：c:\windows中含最多子目录，其子目录有30个，且这30个是不含子目录下的子目录，则动态字串阵列的最大个数便只有30)<br>
</span> </font>
<table border=0 width="693">
<tbody>
<tr>
<td> <font color="#000000" class="unnamed1">' Need a CommandBox<br>
Private FoundFile() as String '存放传回值的字串阵列<br>
Private ntx As Long<br>
<br>
Private Sub Command1_Click()<br>
ntx = 0<br>
Call GetDirPath("c:\", "*.ini")<br>
End Sub<br>
<br>
Private Sub GetDirPath(CurrentPath As String, ByVal SearFile As
String)<br>
Dim nI As Integer, nDirectory As Integer, i As Long<br>
Dim sFileName As String, sDirectoryList() As String<br>
'First list all normal files in this directory<br>
sFileName = Dir(CurrentPath, vbHidden Or vbDirectory Or vbReadOnly
Or vbSystem)<br>
Do While sFileName <> ""<br>
If UCase(sFileName) Like UCase(SearFile) Then<br>
i = GetAttr(CurrentPath + sFileName)<br>
If (i And vbDirectory) = 0 Then<br>
ReDim Preserve FoundFile(ntx)<br>
FoundFile(ntx) = CurrentPath + sFileName<br>
ntx = ntx + 1<br>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -