不用FSO,不用特殊的控件,只能用VB中的标准控件及函数或者API,我自己的算法如下:
设要搜索的文件夹为A,用DIR搜索出在A里面的所有文件及文件夹,把文件夹名放入一个动态数组中,
把文件名列出来。然后以动态数组中每个文件夹名为新的起点,按照上面的方法把新起点的子文件夹
放在上面的动态数组后面,并不破坏原来的数据。如此下去,最后把所有的文件都列出来。希望各位
能给出更优的算法,更快,更简单的算法,能给出意见的就给分。
在VB中我的代码如下,包括所有的注释在内在50行左右:
'在form1中新建两个listbox,分别为list1,list2;建一个textbox为text1;button为command1
'list1为可见(list1用作显示所有的文件夹名),list2为不可见(list2用作动态数组),
'运行后效果如下:在C盘下共搜索出了15148个文件,共用了30.21秒
Option Explicit
Sub SearchFile(FolderName As String)
Dim FileName As String, tmp As String
FileName = Dir(FolderName & "\", vbDirectory)
Do While Not FileName = ""
If FileName <> "." And FileName <> ".." Then
tmp = FolderName & "\" & FileName
If GetAttr(tmp) = vbDirectory Then
'搜索到的子文件夹存入list2中
List2.AddItem tmp
Else
'搜索到文件显示在list1中
List1.AddItem tmp
End If
End If
FileName = Dir
Loop
End Sub
Private Sub Command1_Click()
Dim i As Integer, j As Integer
i = 0
List1.Clear
SearchFile Text1.Text
Do While i < List2.ListCount
'搜索文件夹
SearchFile List2.List(i)
'每搜索1000个子文件夹就把这1000个了文件夹的名字从list2中删除
'为是为了防止list2中的项目过多超出其极限,
'在我的机上测试后发现在增加此操作后所用的时间大概慢不到一秒。
If i >= 1000 Then
For j = 0 To i - 1
List2.RemoveItem 0
Next
i = 0
End If
'继续下一轮搜索
i = i + 1
Loop
List2.Clear
End Sub
16 个解决方案
#1
瓶颈不在于算法
而是用控件的属性太慢!
而是用控件的属性太慢!
#2
哈哈,没那么麻烦!
你没注意 FileListBox和DirListBox的list和listcount属性吗?
Private Sub SearchFiles(ByVal szStartDir As String)
Dim i As Long, tT As String, tS As String
tS = dirSearchFiles.path
dirSearchFiles.path = szStartDir
fileSearchFiles.path = szStartDir
szSearchSDir = szStartDir
For i = 0 To fileSearchFiles.ListCount - 1
If Not bolStart Then Exit Sub
If fileSearchFiles.List(i) <> "" Then ProcessFile fileSearchFiles.List(i)
DoEvents
Next
For i = 0 To dirSearchFiles.ListCount - 1
If Not bolStart Then Exit Sub
tT = szSearchTDir
szSearchTDir = szSearchTDir + GetSubDir(dirSearchFiles.List(i)) + "\"
SearchFiles dirSearchFiles.List(i)
szSearchTDir = tT
DoEvents
Next
dirSearchFiles.path = tS
End Sub
你没注意 FileListBox和DirListBox的list和listcount属性吗?
Private Sub SearchFiles(ByVal szStartDir As String)
Dim i As Long, tT As String, tS As String
tS = dirSearchFiles.path
dirSearchFiles.path = szStartDir
fileSearchFiles.path = szStartDir
szSearchSDir = szStartDir
For i = 0 To fileSearchFiles.ListCount - 1
If Not bolStart Then Exit Sub
If fileSearchFiles.List(i) <> "" Then ProcessFile fileSearchFiles.List(i)
DoEvents
Next
For i = 0 To dirSearchFiles.ListCount - 1
If Not bolStart Then Exit Sub
tT = szSearchTDir
szSearchTDir = szSearchTDir + GetSubDir(dirSearchFiles.List(i)) + "\"
SearchFiles dirSearchFiles.List(i)
szSearchTDir = tT
DoEvents
Next
dirSearchFiles.path = tS
End Sub
#3
to zyl910(910:分儿,我来了!) (L2002):
我本来是用一个动态数组来存的,为简化起见,所以用控件。
我在VB中,只作查找,不加入list中作显示,时间也只快1秒。
我在VC中不用控件,找查找也不见得快很多。
以上都是用我以上的算法写的。
to Chice_wxg(VS.NET = 光驱烤肉,我也入网了):
我试试你的方法。
to all:
我原本是想给100分的,但手快只给了20,以后再加分。
我本来是用一个动态数组来存的,为简化起见,所以用控件。
我在VB中,只作查找,不加入list中作显示,时间也只快1秒。
我在VC中不用控件,找查找也不见得快很多。
以上都是用我以上的算法写的。
to Chice_wxg(VS.NET = 光驱烤肉,我也入网了):
我试试你的方法。
to all:
我原本是想给100分的,但手快只给了20,以后再加分。
#4
to Chice_wxg(VS.NET = 光驱烤肉,我也入网了):
你是不是贴少了代码啦?ProcessFile还未定义呢
你是不是贴少了代码啦?ProcessFile还未定义呢
#5
这是本人对整个硬盘搜索某个文件的两个子函数:
Sub SearchFile(MyFolder)
Set f2 = MyFolder.Files
For Each f22 In f2
If Abort Then
Exit Sub
Else
If TxtFile.Text = "*.*" Then
frmResult.ListResult.AddItem Space(10) & f22
ElseIf InStr(1, Fso.GetFileName(f22), TxtFile.Text, vbTextCompare) Then
frmResult.ListResult.AddItem Space(10) & f22
End If
End If
Next
End Sub
Sub GetFolder(FolderStart As String, SubFolderStart As String)
If Right(FolderStart, 1) <> "\" Then
FolderStart = FolderStart & "\"
End If
Set f = Fso.GetFolder(FolderStart & SubFolderStart)
Set fc = f.SubFolders
For Each FolderItem In fc
If FolderIte = Folder Then
SearchFile FolderItem
GetFolder FolderStart & SubFolderStart & "\", FolderItem.Name
End If
Next
End Sub
Sub SearchFile(MyFolder)
Set f2 = MyFolder.Files
For Each f22 In f2
If Abort Then
Exit Sub
Else
If TxtFile.Text = "*.*" Then
frmResult.ListResult.AddItem Space(10) & f22
ElseIf InStr(1, Fso.GetFileName(f22), TxtFile.Text, vbTextCompare) Then
frmResult.ListResult.AddItem Space(10) & f22
End If
End If
Next
End Sub
Sub GetFolder(FolderStart As String, SubFolderStart As String)
If Right(FolderStart, 1) <> "\" Then
FolderStart = FolderStart & "\"
End If
Set f = Fso.GetFolder(FolderStart & SubFolderStart)
Set fc = f.SubFolders
For Each FolderItem In fc
If FolderIte = Folder Then
SearchFile FolderItem
GetFolder FolderStart & SubFolderStart & "\", FolderItem.Name
End If
Next
End Sub
#6
关注
#7
to Struggling():
我需要的是用标准控件和标准函数实现呀。因为在有些时候没法用fso.
我需要的是用标准控件和标准函数实现呀。因为在有些时候没法用fso.
#8
使用DIR这函数隐藏文件里搜索不到的,用API比较好而且比DIR快
#9
可以具体些吗? zhuangbx220(星)
#10
你来我宿舍啦! 我解答比你听啦。。。
#11
ProcessFile 就是已经找到了文件,怎么处理你看着办
还有,Dir可以搜索隐藏文件,例如
Dir("*.*",vbHide大概是这个,忘了,反正有提示)
#12
Chice_wxg(VS.NET = 光驱烤肉,我也入网了) :
循环中用doevents,这速度,能快吗?
循环中用doevents,这速度,能快吗?
#13
Chice_wxg(VS.NET = 光驱烤肉,我也入网了) :
循环中用doevents,这速度,能快吗?
循环中用doevents,这速度,能快吗?
#14
当然了,这是我程序里的一个代码,要求用户能手动停止搜索,才加的 Doevents
如果不用DoEvents,不影响使用,就是无法手动终止搜索了~~~~~
多谢 no_com(探花) 提醒 ^_^
如果不用DoEvents,不影响使用,就是无法手动终止搜索了~~~~~
多谢 no_com(探花) 提醒 ^_^
#15
to Chice_wxg(VS.NET = 光驱烤肉,我也入网了):
GetSubDir(dirSearchFiles.List(i))提示函数未找到
GetSubDir(dirSearchFiles.List(i))提示函数未找到
#16
Dir中,加vbHide 参数你搜索到的只能是隐含文件,还是用API来做吧。
下面的程式是别人写的我只是COPY过来给大家看看。
Option Explicit
'sDirTraversal 参数说明:
' strPathName 要遍历的目录(路径)
'当遍历C盘时,不能使用 c:\ 应使用 c:
' objList 使用VB的内部控件ListBox来存放遍历得到的路径(文件名路径)
'''''''''''''''''''''''''''''''''''''''''''
'API函数的声明、常量、自定义数据类型
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'API函数的声明
Public Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
'---------------------------------------------------------------
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'最大路径长度和文件属性常量的定义
Public Const MAX_PATH = 260
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
'--------------
Public Const LB_FINDSTRING = &H18F '查找列表框中匹配的项目'
Public Find_S As Boolean
Public strFile2 As String
Public lng_i As Long
'List1.ListIndex = SendMessage(List1.hwnd,LB_FINDSTRING,-1,ByVal Text1.Text)
'--------------------------------------------
'自定义数据类型FILETIME和WIN32_FIND_DATA的定义
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Public bStop As Boolean '--退出循环
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'去掉固定长度字符串右边的NULL字符(ASCII值为0)和SPACE字符(ASCII值为32)函数
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function fDelInvaildChr(str As String) As String
On Error Resume Next
Dim i As Long
For i = Len(str) To 1 Step -1
If Asc(Mid(str, i, 1)) <> 0 And Asc(Mid(str, i, 1)) <> 32 Then
fDelInvaildChr = Left(str, i)
Exit For
End If
Next
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'遍历主函数
'参数说明:
' strPathName 要遍历的目录
' objList 使用VB的内部控件ListBox来存放遍历得到的路径,之所以
' 不使用字符串数组是因为数组大小不好定义
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub sDirTraversal(ByVal strPathName As String, ByRef objList As ListBox, Optional sType As String = "*.*", Optional bLoop As Boolean = True)
Dim sSubDir(200) As String '存放当前目录下的子目录,下标可根据需要调整
Dim iIndex As Integer '子目录数组下标
Dim i As Integer '用于循环子目录的查找
Dim j As Long
Dim lHandle As Long 'FindFirstFileA 的句柄
Dim tFindData As WIN32_FIND_DATA '
Dim strFileName As String '文件名
Dim sTmp As String, sTmpType As String
On Error Resume Next
'初始化变量
i = 1
iIndex = 0
tFindData.cFileName = "" '初始化定长字符串
If Right(strPathName, 1) <> "\" Then strPathName = strPathName & "\"
lHandle = FindFirstFile(strPathName & "*.*", tFindData)
If lHandle = 0 Then '查询结束或发生错误
Exit Sub
End If
sType = UCase(sType)
strFileName = fDelInvaildChr(tFindData.cFileName)
If tFindData.dwFileAttributes = &H10 Then '目录
If strFileName <> "." And strFileName <> ".." Then
iIndex = iIndex + 1
sSubDir(iIndex) = strPathName & strFileName '添加到目录数组
End If
Else
' sTmp = Dir(strPathName & strFileName)
' If sTmp <> "" Then
' sTmp = Get_FileInfo(strPathName & strFileName)
' If UCase(sTmp) = sType Or sType = "*" Then
objList.AddItem strPathName & strFileName
' End If
' End If
End If
'循环查找下一个文件,直到结束
Do While True
tFindData.cFileName = ""
If FindNextFile(lHandle, tFindData) = 0 Then '查询结束或发生错误
FindClose (lHandle)
Exit Do
Else
strFileName = fDelInvaildChr(tFindData.cFileName)
If tFindData.dwFileAttributes = &H10 Then
If strFileName <> "." And strFileName <> ".." Then
iIndex = iIndex + 1
sSubDir(iIndex) = strPathName & strFileName '添加到目录数组
End If
Else
' sTmp = Dir(strPathName & strFileName)
' If sTmp <> "" Then
' If sTmp <> "" Then
' sTmp = Get_FileInfo(strPathName & strFileName)
'
' If UCase(sTmp) = sType Or sType = "*" Then
objList.AddItem strPathName & strFileName
' End If
' End If
End If
' End If
End If
If bStop Then '---退出循环(停止)
Exit Do
Exit Sub
End If
Loop
If bStop Then Exit Sub
DoEvents
'如果该目录下有目录,则根据目录数组递归遍历
If bLoop = False Then Exit Sub
If iIndex > 0 Then
For i = 1 To iIndex
sDirTraversal sSubDir(i), objList, sType, bLoop
Next
End If
End Sub
下面的程式是别人写的我只是COPY过来给大家看看。
Option Explicit
'sDirTraversal 参数说明:
' strPathName 要遍历的目录(路径)
'当遍历C盘时,不能使用 c:\ 应使用 c:
' objList 使用VB的内部控件ListBox来存放遍历得到的路径(文件名路径)
'''''''''''''''''''''''''''''''''''''''''''
'API函数的声明、常量、自定义数据类型
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'API函数的声明
Public Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
'---------------------------------------------------------------
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'最大路径长度和文件属性常量的定义
Public Const MAX_PATH = 260
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
'--------------
Public Const LB_FINDSTRING = &H18F '查找列表框中匹配的项目'
Public Find_S As Boolean
Public strFile2 As String
Public lng_i As Long
'List1.ListIndex = SendMessage(List1.hwnd,LB_FINDSTRING,-1,ByVal Text1.Text)
'--------------------------------------------
'自定义数据类型FILETIME和WIN32_FIND_DATA的定义
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Public bStop As Boolean '--退出循环
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'去掉固定长度字符串右边的NULL字符(ASCII值为0)和SPACE字符(ASCII值为32)函数
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function fDelInvaildChr(str As String) As String
On Error Resume Next
Dim i As Long
For i = Len(str) To 1 Step -1
If Asc(Mid(str, i, 1)) <> 0 And Asc(Mid(str, i, 1)) <> 32 Then
fDelInvaildChr = Left(str, i)
Exit For
End If
Next
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'遍历主函数
'参数说明:
' strPathName 要遍历的目录
' objList 使用VB的内部控件ListBox来存放遍历得到的路径,之所以
' 不使用字符串数组是因为数组大小不好定义
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub sDirTraversal(ByVal strPathName As String, ByRef objList As ListBox, Optional sType As String = "*.*", Optional bLoop As Boolean = True)
Dim sSubDir(200) As String '存放当前目录下的子目录,下标可根据需要调整
Dim iIndex As Integer '子目录数组下标
Dim i As Integer '用于循环子目录的查找
Dim j As Long
Dim lHandle As Long 'FindFirstFileA 的句柄
Dim tFindData As WIN32_FIND_DATA '
Dim strFileName As String '文件名
Dim sTmp As String, sTmpType As String
On Error Resume Next
'初始化变量
i = 1
iIndex = 0
tFindData.cFileName = "" '初始化定长字符串
If Right(strPathName, 1) <> "\" Then strPathName = strPathName & "\"
lHandle = FindFirstFile(strPathName & "*.*", tFindData)
If lHandle = 0 Then '查询结束或发生错误
Exit Sub
End If
sType = UCase(sType)
strFileName = fDelInvaildChr(tFindData.cFileName)
If tFindData.dwFileAttributes = &H10 Then '目录
If strFileName <> "." And strFileName <> ".." Then
iIndex = iIndex + 1
sSubDir(iIndex) = strPathName & strFileName '添加到目录数组
End If
Else
' sTmp = Dir(strPathName & strFileName)
' If sTmp <> "" Then
' sTmp = Get_FileInfo(strPathName & strFileName)
' If UCase(sTmp) = sType Or sType = "*" Then
objList.AddItem strPathName & strFileName
' End If
' End If
End If
'循环查找下一个文件,直到结束
Do While True
tFindData.cFileName = ""
If FindNextFile(lHandle, tFindData) = 0 Then '查询结束或发生错误
FindClose (lHandle)
Exit Do
Else
strFileName = fDelInvaildChr(tFindData.cFileName)
If tFindData.dwFileAttributes = &H10 Then
If strFileName <> "." And strFileName <> ".." Then
iIndex = iIndex + 1
sSubDir(iIndex) = strPathName & strFileName '添加到目录数组
End If
Else
' sTmp = Dir(strPathName & strFileName)
' If sTmp <> "" Then
' If sTmp <> "" Then
' sTmp = Get_FileInfo(strPathName & strFileName)
'
' If UCase(sTmp) = sType Or sType = "*" Then
objList.AddItem strPathName & strFileName
' End If
' End If
End If
' End If
End If
If bStop Then '---退出循环(停止)
Exit Do
Exit Sub
End If
Loop
If bStop Then Exit Sub
DoEvents
'如果该目录下有目录,则根据目录数组递归遍历
If bLoop = False Then Exit Sub
If iIndex > 0 Then
For i = 1 To iIndex
sDirTraversal sSubDir(i), objList, sType, bLoop
Next
End If
End Sub
#1
瓶颈不在于算法
而是用控件的属性太慢!
而是用控件的属性太慢!
#2
哈哈,没那么麻烦!
你没注意 FileListBox和DirListBox的list和listcount属性吗?
Private Sub SearchFiles(ByVal szStartDir As String)
Dim i As Long, tT As String, tS As String
tS = dirSearchFiles.path
dirSearchFiles.path = szStartDir
fileSearchFiles.path = szStartDir
szSearchSDir = szStartDir
For i = 0 To fileSearchFiles.ListCount - 1
If Not bolStart Then Exit Sub
If fileSearchFiles.List(i) <> "" Then ProcessFile fileSearchFiles.List(i)
DoEvents
Next
For i = 0 To dirSearchFiles.ListCount - 1
If Not bolStart Then Exit Sub
tT = szSearchTDir
szSearchTDir = szSearchTDir + GetSubDir(dirSearchFiles.List(i)) + "\"
SearchFiles dirSearchFiles.List(i)
szSearchTDir = tT
DoEvents
Next
dirSearchFiles.path = tS
End Sub
你没注意 FileListBox和DirListBox的list和listcount属性吗?
Private Sub SearchFiles(ByVal szStartDir As String)
Dim i As Long, tT As String, tS As String
tS = dirSearchFiles.path
dirSearchFiles.path = szStartDir
fileSearchFiles.path = szStartDir
szSearchSDir = szStartDir
For i = 0 To fileSearchFiles.ListCount - 1
If Not bolStart Then Exit Sub
If fileSearchFiles.List(i) <> "" Then ProcessFile fileSearchFiles.List(i)
DoEvents
Next
For i = 0 To dirSearchFiles.ListCount - 1
If Not bolStart Then Exit Sub
tT = szSearchTDir
szSearchTDir = szSearchTDir + GetSubDir(dirSearchFiles.List(i)) + "\"
SearchFiles dirSearchFiles.List(i)
szSearchTDir = tT
DoEvents
Next
dirSearchFiles.path = tS
End Sub
#3
to zyl910(910:分儿,我来了!) (L2002):
我本来是用一个动态数组来存的,为简化起见,所以用控件。
我在VB中,只作查找,不加入list中作显示,时间也只快1秒。
我在VC中不用控件,找查找也不见得快很多。
以上都是用我以上的算法写的。
to Chice_wxg(VS.NET = 光驱烤肉,我也入网了):
我试试你的方法。
to all:
我原本是想给100分的,但手快只给了20,以后再加分。
我本来是用一个动态数组来存的,为简化起见,所以用控件。
我在VB中,只作查找,不加入list中作显示,时间也只快1秒。
我在VC中不用控件,找查找也不见得快很多。
以上都是用我以上的算法写的。
to Chice_wxg(VS.NET = 光驱烤肉,我也入网了):
我试试你的方法。
to all:
我原本是想给100分的,但手快只给了20,以后再加分。
#4
to Chice_wxg(VS.NET = 光驱烤肉,我也入网了):
你是不是贴少了代码啦?ProcessFile还未定义呢
你是不是贴少了代码啦?ProcessFile还未定义呢
#5
这是本人对整个硬盘搜索某个文件的两个子函数:
Sub SearchFile(MyFolder)
Set f2 = MyFolder.Files
For Each f22 In f2
If Abort Then
Exit Sub
Else
If TxtFile.Text = "*.*" Then
frmResult.ListResult.AddItem Space(10) & f22
ElseIf InStr(1, Fso.GetFileName(f22), TxtFile.Text, vbTextCompare) Then
frmResult.ListResult.AddItem Space(10) & f22
End If
End If
Next
End Sub
Sub GetFolder(FolderStart As String, SubFolderStart As String)
If Right(FolderStart, 1) <> "\" Then
FolderStart = FolderStart & "\"
End If
Set f = Fso.GetFolder(FolderStart & SubFolderStart)
Set fc = f.SubFolders
For Each FolderItem In fc
If FolderIte = Folder Then
SearchFile FolderItem
GetFolder FolderStart & SubFolderStart & "\", FolderItem.Name
End If
Next
End Sub
Sub SearchFile(MyFolder)
Set f2 = MyFolder.Files
For Each f22 In f2
If Abort Then
Exit Sub
Else
If TxtFile.Text = "*.*" Then
frmResult.ListResult.AddItem Space(10) & f22
ElseIf InStr(1, Fso.GetFileName(f22), TxtFile.Text, vbTextCompare) Then
frmResult.ListResult.AddItem Space(10) & f22
End If
End If
Next
End Sub
Sub GetFolder(FolderStart As String, SubFolderStart As String)
If Right(FolderStart, 1) <> "\" Then
FolderStart = FolderStart & "\"
End If
Set f = Fso.GetFolder(FolderStart & SubFolderStart)
Set fc = f.SubFolders
For Each FolderItem In fc
If FolderIte = Folder Then
SearchFile FolderItem
GetFolder FolderStart & SubFolderStart & "\", FolderItem.Name
End If
Next
End Sub
#6
关注
#7
to Struggling():
我需要的是用标准控件和标准函数实现呀。因为在有些时候没法用fso.
我需要的是用标准控件和标准函数实现呀。因为在有些时候没法用fso.
#8
使用DIR这函数隐藏文件里搜索不到的,用API比较好而且比DIR快
#9
可以具体些吗? zhuangbx220(星)
#10
你来我宿舍啦! 我解答比你听啦。。。
#11
ProcessFile 就是已经找到了文件,怎么处理你看着办
还有,Dir可以搜索隐藏文件,例如
Dir("*.*",vbHide大概是这个,忘了,反正有提示)
#12
Chice_wxg(VS.NET = 光驱烤肉,我也入网了) :
循环中用doevents,这速度,能快吗?
循环中用doevents,这速度,能快吗?
#13
Chice_wxg(VS.NET = 光驱烤肉,我也入网了) :
循环中用doevents,这速度,能快吗?
循环中用doevents,这速度,能快吗?
#14
当然了,这是我程序里的一个代码,要求用户能手动停止搜索,才加的 Doevents
如果不用DoEvents,不影响使用,就是无法手动终止搜索了~~~~~
多谢 no_com(探花) 提醒 ^_^
如果不用DoEvents,不影响使用,就是无法手动终止搜索了~~~~~
多谢 no_com(探花) 提醒 ^_^
#15
to Chice_wxg(VS.NET = 光驱烤肉,我也入网了):
GetSubDir(dirSearchFiles.List(i))提示函数未找到
GetSubDir(dirSearchFiles.List(i))提示函数未找到
#16
Dir中,加vbHide 参数你搜索到的只能是隐含文件,还是用API来做吧。
下面的程式是别人写的我只是COPY过来给大家看看。
Option Explicit
'sDirTraversal 参数说明:
' strPathName 要遍历的目录(路径)
'当遍历C盘时,不能使用 c:\ 应使用 c:
' objList 使用VB的内部控件ListBox来存放遍历得到的路径(文件名路径)
'''''''''''''''''''''''''''''''''''''''''''
'API函数的声明、常量、自定义数据类型
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'API函数的声明
Public Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
'---------------------------------------------------------------
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'最大路径长度和文件属性常量的定义
Public Const MAX_PATH = 260
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
'--------------
Public Const LB_FINDSTRING = &H18F '查找列表框中匹配的项目'
Public Find_S As Boolean
Public strFile2 As String
Public lng_i As Long
'List1.ListIndex = SendMessage(List1.hwnd,LB_FINDSTRING,-1,ByVal Text1.Text)
'--------------------------------------------
'自定义数据类型FILETIME和WIN32_FIND_DATA的定义
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Public bStop As Boolean '--退出循环
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'去掉固定长度字符串右边的NULL字符(ASCII值为0)和SPACE字符(ASCII值为32)函数
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function fDelInvaildChr(str As String) As String
On Error Resume Next
Dim i As Long
For i = Len(str) To 1 Step -1
If Asc(Mid(str, i, 1)) <> 0 And Asc(Mid(str, i, 1)) <> 32 Then
fDelInvaildChr = Left(str, i)
Exit For
End If
Next
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'遍历主函数
'参数说明:
' strPathName 要遍历的目录
' objList 使用VB的内部控件ListBox来存放遍历得到的路径,之所以
' 不使用字符串数组是因为数组大小不好定义
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub sDirTraversal(ByVal strPathName As String, ByRef objList As ListBox, Optional sType As String = "*.*", Optional bLoop As Boolean = True)
Dim sSubDir(200) As String '存放当前目录下的子目录,下标可根据需要调整
Dim iIndex As Integer '子目录数组下标
Dim i As Integer '用于循环子目录的查找
Dim j As Long
Dim lHandle As Long 'FindFirstFileA 的句柄
Dim tFindData As WIN32_FIND_DATA '
Dim strFileName As String '文件名
Dim sTmp As String, sTmpType As String
On Error Resume Next
'初始化变量
i = 1
iIndex = 0
tFindData.cFileName = "" '初始化定长字符串
If Right(strPathName, 1) <> "\" Then strPathName = strPathName & "\"
lHandle = FindFirstFile(strPathName & "*.*", tFindData)
If lHandle = 0 Then '查询结束或发生错误
Exit Sub
End If
sType = UCase(sType)
strFileName = fDelInvaildChr(tFindData.cFileName)
If tFindData.dwFileAttributes = &H10 Then '目录
If strFileName <> "." And strFileName <> ".." Then
iIndex = iIndex + 1
sSubDir(iIndex) = strPathName & strFileName '添加到目录数组
End If
Else
' sTmp = Dir(strPathName & strFileName)
' If sTmp <> "" Then
' sTmp = Get_FileInfo(strPathName & strFileName)
' If UCase(sTmp) = sType Or sType = "*" Then
objList.AddItem strPathName & strFileName
' End If
' End If
End If
'循环查找下一个文件,直到结束
Do While True
tFindData.cFileName = ""
If FindNextFile(lHandle, tFindData) = 0 Then '查询结束或发生错误
FindClose (lHandle)
Exit Do
Else
strFileName = fDelInvaildChr(tFindData.cFileName)
If tFindData.dwFileAttributes = &H10 Then
If strFileName <> "." And strFileName <> ".." Then
iIndex = iIndex + 1
sSubDir(iIndex) = strPathName & strFileName '添加到目录数组
End If
Else
' sTmp = Dir(strPathName & strFileName)
' If sTmp <> "" Then
' If sTmp <> "" Then
' sTmp = Get_FileInfo(strPathName & strFileName)
'
' If UCase(sTmp) = sType Or sType = "*" Then
objList.AddItem strPathName & strFileName
' End If
' End If
End If
' End If
End If
If bStop Then '---退出循环(停止)
Exit Do
Exit Sub
End If
Loop
If bStop Then Exit Sub
DoEvents
'如果该目录下有目录,则根据目录数组递归遍历
If bLoop = False Then Exit Sub
If iIndex > 0 Then
For i = 1 To iIndex
sDirTraversal sSubDir(i), objList, sType, bLoop
Next
End If
End Sub
下面的程式是别人写的我只是COPY过来给大家看看。
Option Explicit
'sDirTraversal 参数说明:
' strPathName 要遍历的目录(路径)
'当遍历C盘时,不能使用 c:\ 应使用 c:
' objList 使用VB的内部控件ListBox来存放遍历得到的路径(文件名路径)
'''''''''''''''''''''''''''''''''''''''''''
'API函数的声明、常量、自定义数据类型
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'API函数的声明
Public Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
'---------------------------------------------------------------
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'最大路径长度和文件属性常量的定义
Public Const MAX_PATH = 260
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
'--------------
Public Const LB_FINDSTRING = &H18F '查找列表框中匹配的项目'
Public Find_S As Boolean
Public strFile2 As String
Public lng_i As Long
'List1.ListIndex = SendMessage(List1.hwnd,LB_FINDSTRING,-1,ByVal Text1.Text)
'--------------------------------------------
'自定义数据类型FILETIME和WIN32_FIND_DATA的定义
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Public bStop As Boolean '--退出循环
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'去掉固定长度字符串右边的NULL字符(ASCII值为0)和SPACE字符(ASCII值为32)函数
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function fDelInvaildChr(str As String) As String
On Error Resume Next
Dim i As Long
For i = Len(str) To 1 Step -1
If Asc(Mid(str, i, 1)) <> 0 And Asc(Mid(str, i, 1)) <> 32 Then
fDelInvaildChr = Left(str, i)
Exit For
End If
Next
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'遍历主函数
'参数说明:
' strPathName 要遍历的目录
' objList 使用VB的内部控件ListBox来存放遍历得到的路径,之所以
' 不使用字符串数组是因为数组大小不好定义
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub sDirTraversal(ByVal strPathName As String, ByRef objList As ListBox, Optional sType As String = "*.*", Optional bLoop As Boolean = True)
Dim sSubDir(200) As String '存放当前目录下的子目录,下标可根据需要调整
Dim iIndex As Integer '子目录数组下标
Dim i As Integer '用于循环子目录的查找
Dim j As Long
Dim lHandle As Long 'FindFirstFileA 的句柄
Dim tFindData As WIN32_FIND_DATA '
Dim strFileName As String '文件名
Dim sTmp As String, sTmpType As String
On Error Resume Next
'初始化变量
i = 1
iIndex = 0
tFindData.cFileName = "" '初始化定长字符串
If Right(strPathName, 1) <> "\" Then strPathName = strPathName & "\"
lHandle = FindFirstFile(strPathName & "*.*", tFindData)
If lHandle = 0 Then '查询结束或发生错误
Exit Sub
End If
sType = UCase(sType)
strFileName = fDelInvaildChr(tFindData.cFileName)
If tFindData.dwFileAttributes = &H10 Then '目录
If strFileName <> "." And strFileName <> ".." Then
iIndex = iIndex + 1
sSubDir(iIndex) = strPathName & strFileName '添加到目录数组
End If
Else
' sTmp = Dir(strPathName & strFileName)
' If sTmp <> "" Then
' sTmp = Get_FileInfo(strPathName & strFileName)
' If UCase(sTmp) = sType Or sType = "*" Then
objList.AddItem strPathName & strFileName
' End If
' End If
End If
'循环查找下一个文件,直到结束
Do While True
tFindData.cFileName = ""
If FindNextFile(lHandle, tFindData) = 0 Then '查询结束或发生错误
FindClose (lHandle)
Exit Do
Else
strFileName = fDelInvaildChr(tFindData.cFileName)
If tFindData.dwFileAttributes = &H10 Then
If strFileName <> "." And strFileName <> ".." Then
iIndex = iIndex + 1
sSubDir(iIndex) = strPathName & strFileName '添加到目录数组
End If
Else
' sTmp = Dir(strPathName & strFileName)
' If sTmp <> "" Then
' If sTmp <> "" Then
' sTmp = Get_FileInfo(strPathName & strFileName)
'
' If UCase(sTmp) = sType Or sType = "*" Then
objList.AddItem strPathName & strFileName
' End If
' End If
End If
' End If
End If
If bStop Then '---退出循环(停止)
Exit Do
Exit Sub
End If
Loop
If bStop Then Exit Sub
DoEvents
'如果该目录下有目录,则根据目录数组递归遍历
If bLoop = False Then Exit Sub
If iIndex > 0 Then
For i = 1 To iIndex
sDirTraversal sSubDir(i), objList, sType, bLoop
Next
End If
End Sub