[技术讨论] VBS WMI 遍历文件夹与 FSO 遍历文件夹速度对比

yu2n

WMI 遍历文件夹与 FSO 遍历文件夹速度对比

' WMI 遍历文件夹与 FSO 遍历文件夹速度对比
TestDir = "D:\back\boot"

Test
Sub Test()
	Dim dt1, dt2, dt3
	dt1 = Timer()
	ScanFolder2 TestDir
	dt2 = Timer()
	ScanFolder TestDir
	dt3 = Timer()
	WScript.Echo "WMI Timer: " & (dt2-dt1) & vbCrLf & _
				"FSO Timer: " & (dt3-dt2)
End Sub


' WMI 获取文件夹所有文件夹、文件列表
Sub ScanFolder2(Byval strFolder)
	On Error Resume Next
	Dim objWMIService, FileList, objFile, FolderList, objFolder
	Const strComputer = "."
	Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
	Set FileList = objWMIService.ExecQuery _
		("ASSOCIATORS OF {Win32_Directory.Name='" & strFolder & "'} Where " _
			& "ResultClass = CIM_DataFile")
	For Each objFile In FileList
		'WScript.Echo objFile.Name
	Next
	Set FolderList = objWMIService.ExecQuery _
		("Associators of {Win32_Directory.Name='" & strFolder & "'} " _
		& "Where AssocClass = Win32_Subdirectory " _
		& "ResultRole = PartComponent")
	For Each objFolder In FolderList
		ScanFolder2 objFolder.name
	Next
End Sub


' FSO 获取文件夹所有文件夹、文件列表(数组)
Function ScanFolder(ByVal strDir)
  If Right(strDir, 1) <> "\" Then strDir = strDir & "\"
  Dim arr() : ReDim Preserve arr(0) : arr(0) = strDir
  Call SCAN_FOLDER(arr, strDir) : ScanFolder = arr
End Function
Function SCAN_FOLDER(ByRef arr, ByVal strDir)
  On Error Resume Next
  Dim fso, objItems, objFile, objFolder
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set objItems = fso.GetFolder(strDir)
  If (Not fso.FolderExists(strDir)) Then Exit Function
  For Each objFile In objItems.Files
    ReDim Preserve arr(UBound(arr) + 1)
    arr(UBound(arr)) = objFile.Path
  Next
  For Each objFolder In objItems.subfolders
    ReDim Preserve arr(UBound(arr) + 1)
    arr(UBound(arr)) = objFolder.Path & "\"
    Call SCAN_FOLDER(arr, objFolder.Path & "\")
  Next
End Function
复制代码

结果如下：

---------------------------
Windows Script Host
---------------------------
WMI Timer: 2.65625

FSO Timer: 0.0546875
---------------------------
确定   
---------------------------
复制代码

为什么 WMI 这么慢？为什么很多人都推荐 WMI 搜寻文件？难道是我打开方式不对？

523066680

回复 1# yu2n

反过来试了一个稍大的目录：

Test
Sub Test()
	Dim dt1, dt2, dt3
	dt1 = Timer()
	ScanFolder TestDir
	dt2 = Timer()
	ScanFolder2 TestDir
	dt3 = Timer()
	WScript.Echo "FSO Timer: " & (dt2-dt1) & vbCrLf & _
				"WMI Timer: " & (dt3-dt2)
End Sub
复制代码

---------------------------
Windows Script Host
---------------------------
FSO Timer: 4.287109

WMI Timer: 151.8555
---------------------------
确定   
---------------------------

yu2n

回复 2# 523066680


重複使用同一個 fso，還能更快一些：

Option Explicit

Call CommandMode()

Test
Sub Test()
	Dim fd1, dt1, dt2, arr
	fd1 = "D:\"
	dt1 = Timer()
	arr = ScanFolder(fd1)
	dt2 = Timer()
	WScript.Echo "文件、文件夾個數：" & UBound(arr) & vbCrLf & _
		"耗時：" & (dt2 - dt1) & " 秒"
End Sub

'************************************************************************
'FSO 获取指定文件夹下，所有文件、文件夹的路径（返回一维数组列表）
'************************************************************************
Function ScanFolder(ByVal strFolder)
	Dim fso, arrList()
	ReDim Preserve arrList(0)
	Set fso = CreateObject("Scripting.FileSystemObject")
	If fso.FolderExists(strFolder) Then
		arrList(0) = fso.GetFolder(strFolder).Path & "\"
		Call DO_SCAN_FOLDER(fso, arrList, strFolder) 
	End If
	ScanFolder = arrList
End Function
Sub DO_SCAN_FOLDER(ByRef fso, ByRef arr, ByVal str)
	Dim oItems, oFile, oFolder
	On Error Resume Next
	Set oItems = fso.GetFolder(str)
	For Each oFile In oItems.Files
		ReDim Preserve arr(UBound(arr) + 1)
		arr(UBound(arr)) = oFile.Path
	Next
	For Each oFolder In oItems.subfolders
		ReDim Preserve arr(UBound(arr) + 1)
		arr(UBound(arr)) = oFolder.Path & "\"
		Call DO_SCAN_FOLDER(fso, arr, oFolder.Path & "\")
	Next
End Sub


'************************************************************************
'命令行模式运行
'************************************************************************
Sub CommandMode()
	If InStr(1, WScript.FullName, "\cscript.exe", vbTextCompare) > 0 Then Exit Sub
	CreateObject("WScript.Shell").Run "cmd /c title " & WScript.ScriptName & _
		" & cscript //nologo """ & WScript.ScriptFullName & """ & pause", 1, False
	WScript.Quit(0)
End Sub
复制代码

測試結果如下：

文件、文件夾個數：188575
耗時：60.46875 秒
复制代码

感覺還是慢了，這似乎是FSO的極限了？我以為 WMI 能更快的，結果一試~尷尬了。

CrLf

用 168G 大的日常工作文件夹做测试，至今还没看到结果...

老刘1号

FSO的速度还是比较靠谱的……

879792799

好好啊好好好好