Board logo

标题: [技术讨论] VBS WMI 遍历文件夹与 FSO 遍历文件夹速度对比 [打印本页]

作者: yu2n    时间: 2017-5-4 23:17     标题: VBS WMI 遍历文件夹与 FSO 遍历文件夹速度对比

WMI 遍历文件夹与 FSO 遍历文件夹速度对比
  1. ' WMI 遍历文件夹与 FSO 遍历文件夹速度对比
  2. TestDir = "D:\back\boot"
  3. Test
  4. Sub Test()
  5. Dim dt1, dt2, dt3
  6. dt1 = Timer()
  7. ScanFolder2 TestDir
  8. dt2 = Timer()
  9. ScanFolder TestDir
  10. dt3 = Timer()
  11. WScript.Echo "WMI Timer: " & (dt2-dt1) & vbCrLf & _
  12. "FSO Timer: " & (dt3-dt2)
  13. End Sub
  14. ' WMI 获取文件夹所有文件夹、文件列表
  15. Sub ScanFolder2(Byval strFolder)
  16. On Error Resume Next
  17. Dim objWMIService, FileList, objFile, FolderList, objFolder
  18. Const strComputer = "."
  19. Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
  20. Set FileList = objWMIService.ExecQuery _
  21. ("ASSOCIATORS OF {Win32_Directory.Name='" & strFolder & "'} Where " _
  22. & "ResultClass = CIM_DataFile")
  23. For Each objFile In FileList
  24. 'WScript.Echo objFile.Name
  25. Next
  26. Set FolderList = objWMIService.ExecQuery _
  27. ("Associators of {Win32_Directory.Name='" & strFolder & "'} " _
  28. & "Where AssocClass = Win32_Subdirectory " _
  29. & "ResultRole = PartComponent")
  30. For Each objFolder In FolderList
  31. ScanFolder2 objFolder.name
  32. Next
  33. End Sub
  34. ' FSO 获取文件夹所有文件夹、文件列表(数组)
  35. Function ScanFolder(ByVal strDir)
  36.   If Right(strDir, 1) <> "\" Then strDir = strDir & "\"
  37.   Dim arr() : ReDim Preserve arr(0) : arr(0) = strDir
  38.   Call SCAN_FOLDER(arr, strDir) : ScanFolder = arr
  39. End Function
  40. Function SCAN_FOLDER(ByRef arr, ByVal strDir)
  41.   On Error Resume Next
  42.   Dim fso, objItems, objFile, objFolder
  43.   Set fso = CreateObject("Scripting.FileSystemObject")
  44.   Set objItems = fso.GetFolder(strDir)
  45.   If (Not fso.FolderExists(strDir)) Then Exit Function
  46.   For Each objFile In objItems.Files
  47.     ReDim Preserve arr(UBound(arr) + 1)
  48.     arr(UBound(arr)) = objFile.Path
  49.   Next
  50.   For Each objFolder In objItems.subfolders
  51.     ReDim Preserve arr(UBound(arr) + 1)
  52.     arr(UBound(arr)) = objFolder.Path & "\"
  53.     Call SCAN_FOLDER(arr, objFolder.Path & "\")
  54.   Next
  55. End Function
复制代码
结果如下:
  1. ---------------------------
  2. Windows Script Host
  3. ---------------------------
  4. WMI Timer: 2.65625
  5. FSO Timer: 0.0546875
  6. ---------------------------
  7. 确定   
  8. ---------------------------
复制代码
为什么 WMI 这么慢?为什么很多人都推荐 WMI 搜寻文件?难道是我打开方式不对?
作者: 523066680    时间: 2017-5-5 08:36

本帖最后由 523066680 于 2017-5-5 08:38 编辑

回复 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    时间: 2017-5-5 14:13

本帖最后由 yu2n 于 2017-5-5 14:28 编辑

回复 2# 523066680


重複使用同一個 fso,還能更快一些:
  1. Option Explicit
  2. Call CommandMode()
  3. Test
  4. Sub Test()
  5. Dim fd1, dt1, dt2, arr
  6. fd1 = "D:\"
  7. dt1 = Timer()
  8. arr = ScanFolder(fd1)
  9. dt2 = Timer()
  10. WScript.Echo "文件、文件夾個數:" & UBound(arr) & vbCrLf & _
  11. "耗時:" & (dt2 - dt1) & " 秒"
  12. End Sub
  13. '************************************************************************
  14. 'FSO 获取指定文件夹下,所有文件、文件夹的路径(返回一维数组列表)
  15. '************************************************************************
  16. Function ScanFolder(ByVal strFolder)
  17. Dim fso, arrList()
  18. ReDim Preserve arrList(0)
  19. Set fso = CreateObject("Scripting.FileSystemObject")
  20. If fso.FolderExists(strFolder) Then
  21. arrList(0) = fso.GetFolder(strFolder).Path & "\"
  22. Call DO_SCAN_FOLDER(fso, arrList, strFolder)
  23. End If
  24. ScanFolder = arrList
  25. End Function
  26. Sub DO_SCAN_FOLDER(ByRef fso, ByRef arr, ByVal str)
  27. Dim oItems, oFile, oFolder
  28. On Error Resume Next
  29. Set oItems = fso.GetFolder(str)
  30. For Each oFile In oItems.Files
  31. ReDim Preserve arr(UBound(arr) + 1)
  32. arr(UBound(arr)) = oFile.Path
  33. Next
  34. For Each oFolder In oItems.subfolders
  35. ReDim Preserve arr(UBound(arr) + 1)
  36. arr(UBound(arr)) = oFolder.Path & "\"
  37. Call DO_SCAN_FOLDER(fso, arr, oFolder.Path & "\")
  38. Next
  39. End Sub
  40. '************************************************************************
  41. '命令行模式运行
  42. '************************************************************************
  43. Sub CommandMode()
  44. If InStr(1, WScript.FullName, "\cscript.exe", vbTextCompare) > 0 Then Exit Sub
  45. CreateObject("WScript.Shell").Run "cmd /c title " & WScript.ScriptName & _
  46. " & cscript //nologo """ & WScript.ScriptFullName & """ & pause", 1, False
  47. WScript.Quit(0)
  48. End Sub
复制代码
測試結果如下:
  1. 文件、文件夾個數:188575
  2. 耗時:60.46875 秒
复制代码
感覺還是慢了,這似乎是FSO的極限了?我以為 WMI 能更快的,結果一試~尷尬了。
作者: CrLf    时间: 2017-5-5 16:40

用 168G 大的日常工作文件夹做测试,至今还没看到结果...
作者: 老刘1号    时间: 2017-5-5 20:26

FSO的速度还是比较靠谱的……
作者: 879792799    时间: 2017-5-7 15:44

好好啊好好好好




欢迎光临 批处理之家 (http://bbs.bathome.net/) Powered by Discuz! 7.2