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

yu2n

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

1. ' WMI 遍历文件夹与 FSO 遍历文件夹速度对比
   
2. TestDir = "D:\back\boot"
   
3. 
   
4. Test
   
5. Sub Test()
   
6.         Dim dt1, dt2, dt3
   
7.         dt1 = Timer()
   
8.         ScanFolder2 TestDir
   
9.         dt2 = Timer()
   
10.         ScanFolder TestDir
    
11.         dt3 = Timer()
    
12.         WScript.Echo "WMI Timer: " & (dt2-dt1) & vbCrLf & _
    
13.                                 "FSO Timer: " & (dt3-dt2)
    
14. End Sub
    
15. 
    
16. 
    
17. ' WMI 获取文件夹所有文件夹、文件列表
    
18. Sub ScanFolder2(Byval strFolder)
    
19.         On Error Resume Next
    
20.         Dim objWMIService, FileList, objFile, FolderList, objFolder
    
21.         Const strComputer = "."
    
22.         Set objWMIService = GetObject("winmgmts:\" & strComputer & "\root\cimv2")
    
23.         Set FileList = objWMIService.ExecQuery _
    
24.                 ("ASSOCIATORS OF {Win32_Directory.Name='" & strFolder & "'} Where " _
    
25.                         & "ResultClass = CIM_DataFile")
    
26.         For Each objFile In FileList
    
27.                 'WScript.Echo objFile.Name
    
28.         Next
    
29.         Set FolderList = objWMIService.ExecQuery _
    
30.                 ("Associators of {Win32_Directory.Name='" & strFolder & "'} " _
    
31.                 & "Where AssocClass = Win32_Subdirectory " _
    
32.                 & "ResultRole = PartComponent")
    
33.         For Each objFolder In FolderList
    
34.                 ScanFolder2 objFolder.name
    
35.         Next
    
36. End Sub
    
37. 
    
38. 
    
39. ' FSO 获取文件夹所有文件夹、文件列表(数组)
    
40. Function ScanFolder(ByVal strDir)
    
41.   If Right(strDir, 1) <> "" Then strDir = strDir & ""
    
42.   Dim arr() : ReDim Preserve arr(0) : arr(0) = strDir
    
43.   Call SCAN_FOLDER(arr, strDir) : ScanFolder = arr
    
44. End Function
    
45. Function SCAN_FOLDER(ByRef arr, ByVal strDir)
    
46.   On Error Resume Next
    
47.   Dim fso, objItems, objFile, objFolder
    
48.   Set fso = CreateObject("Scripting.FileSystemObject")
    
49.   Set objItems = fso.GetFolder(strDir)
    
50.   If (Not fso.FolderExists(strDir)) Then Exit Function
    
51.   For Each objFile In objItems.Files
    
52.     ReDim Preserve arr(UBound(arr) + 1)
    
53.     arr(UBound(arr)) = objFile.Path
    
54.   Next
    
55.   For Each objFolder In objItems.subfolders
    
56.     ReDim Preserve arr(UBound(arr) + 1)
    
57.     arr(UBound(arr)) = objFolder.Path & ""
    
58.     Call SCAN_FOLDER(arr, objFolder.Path & "")
    
59.   Next
    
60. End Function

复制代码

结果如下：

1. ---------------------------
   
2. Windows Script Host
   
3. ---------------------------
   
4. WMI Timer: 2.65625
   
5. 
   
6. FSO Timer: 0.0546875
   
7. ---------------------------
   
8. 确定   
   
9. ---------------------------
   

复制代码

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

523066680

回复 1# yu2n

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

1. Test
   
2. Sub Test()
   
3.         Dim dt1, dt2, dt3
   
4.         dt1 = Timer()
   
5.         ScanFolder TestDir
   
6.         dt2 = Timer()
   
7.         ScanFolder2 TestDir
   
8.         dt3 = Timer()
   
9.         WScript.Echo "FSO Timer: " & (dt2-dt1) & vbCrLf & _
   
10.                                 "WMI Timer: " & (dt3-dt2)
    
11. End Sub

复制代码

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

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

yu2n

回复 2# 523066680


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

1. Option Explicit
   
2. 
   
3. Call CommandMode()
   
4. 
   
5. Test
   
6. Sub Test()
   
7.         Dim fd1, dt1, dt2, arr
   
8.         fd1 = "D:"
   
9.         dt1 = Timer()
   
10.         arr = ScanFolder(fd1)
    
11.         dt2 = Timer()
    
12.         WScript.Echo "文件、文件夾個數：" & UBound(arr) & vbCrLf & _
    
13.                 "耗時：" & (dt2 - dt1) & " 秒"
    
14. End Sub
    
15. 
    
16. '************************************************************************
    
17. 'FSO 获取指定文件夹下，所有文件、文件夹的路径（返回一维数组列表）
    
18. '************************************************************************
    
19. Function ScanFolder(ByVal strFolder)
    
20.         Dim fso, arrList()
    
21.         ReDim Preserve arrList(0)
    
22.         Set fso = CreateObject("Scripting.FileSystemObject")
    
23.         If fso.FolderExists(strFolder) Then
    
24.                 arrList(0) = fso.GetFolder(strFolder).Path & ""
    
25.                 Call DO_SCAN_FOLDER(fso, arrList, strFolder)
    
26.         End If
    
27.         ScanFolder = arrList
    
28. End Function
    
29. Sub DO_SCAN_FOLDER(ByRef fso, ByRef arr, ByVal str)
    
30.         Dim oItems, oFile, oFolder
    
31.         On Error Resume Next
    
32.         Set oItems = fso.GetFolder(str)
    
33.         For Each oFile In oItems.Files
    
34.                 ReDim Preserve arr(UBound(arr) + 1)
    
35.                 arr(UBound(arr)) = oFile.Path
    
36.         Next
    
37.         For Each oFolder In oItems.subfolders
    
38.                 ReDim Preserve arr(UBound(arr) + 1)
    
39.                 arr(UBound(arr)) = oFolder.Path & ""
    
40.                 Call DO_SCAN_FOLDER(fso, arr, oFolder.Path & "")
    
41.         Next
    
42. End Sub
    
43. 
    
44. 
    
45. '************************************************************************
    
46. '命令行模式运行
    
47. '************************************************************************
    
48. Sub CommandMode()
    
49.         If InStr(1, WScript.FullName, "\cscript.exe", vbTextCompare) > 0 Then Exit Sub
    
50.         CreateObject("WScript.Shell").Run "cmd /c title " & WScript.ScriptName & _
    
51.                 " & cscript //nologo """ & WScript.ScriptFullName & """ & pause", 1, False
    
52.         WScript.Quit(0)
    
53. End Sub

复制代码

測試結果如下：

1. 文件、文件夾個數：188575
   
2. 耗時：60.46875 秒

复制代码

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

CrLf

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

老刘1号

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

879792799

好好啊好好好好