Board logo

标题: [技术讨论] vbs获取系统/IE/DirectX/MediaPlaye/Flash插件/MSXML及各种运行库的版本及安装情况 [打印本页]
作者: czjt1234    时间: 2014-5-7 22:01     标题: vbs获取系统/IE/DirectX/MediaPlaye/Flash插件/MSXML及各种运行库的版本及安装情况

本帖最后由 pcl_test 于 2016-9-13 16:24 编辑

请测试
  1. Wscript.Echo QueryWinVer()   & vbCrLf & QueryDirectX()  & vbCrLf & _

  2.              QueryIEVer()    & vbCrLf & QueryFlashVer() & vbCrLf & _

  3.              QueryMediaVer() & vbCrLf & QueryVC20xx()   & vbCrLf & _

  4.              QueryXML()      & vbCrLf & QueryNET()

  5. 

  6. 'By QQ20147578 2014-05-03

  7. 

  8. Function QueryWinVer()

  9.     '查询WMI的Win32_OperatingSystem和Win32_ComputerSystem，读取操作系统版本

  10.     Dim objSWbemServices, objSWbemObject

  11.     Set objSWbemServices = GetObject("Winmgmts:\\.\Root\Cimv2")

  12.     For Each objSWbemObject In objSWbemServices.InstancesOf("Win32_OperatingSystem")

  13.         QueryWinVer = objSWbemObject.Caption & " " & objSWbemObject.CSDVersion

  14.     Next

  15.     QueryWinVer = QueryWinVer & vbCrLf

  16.     For Each objSWbemObject In objSWbemServices.InstancesOf("Win32_ComputerSystem")

  17.         If InStr(objSWbemObject.SystemType, "86") > 0 Then

  18.             QueryWinVer = QueryWinVer & "32位 操作系统"

  19.         ElseIf InStr(objSWbemObject.SystemType, "64") > 0 Then

  20.             QueryWinVer = QueryWinVer & "64位 操作系统"

  21.         Else

  22.             QueryWinVer = QueryWinVer & objSWbemObject.SystemType

  23.         End If

  24.     Next

  25.     QueryWinVer = QueryWinVer & vbCrLf

  26. End Function

  27. 

  28. Function QueryDirectX()

  29.     '读取C:\Windows\System32\dxdiag.exe的文件版本，判断DirectX版本

  30.     '读取C:\Windows\System32\XAudio2_7.dll的文件版本，判断DirectX最终用户运行时版本

  31.     Dim s, objFSO, objWshShell

  32.     Set objFSO      = CreateObject("Scripting.FileSystemObject")

  33.     Set objWshShell = CreateObject("Wscript.Shell")

  34.     s = objWshShell.ExpandEnvironmentStrings("%SystemRoot%\System32\dxdiag.exe")

  35.     If objFSO.FileExists(s) = False Then

  36.         QueryDirectX = "未能找到 dxdiag.exe 文件，DirectX 版本 查询失败"

  37.     Else

  38.         s = objFSO.GetFileVersion(s)

  39.         If s < "4.09.00.0904" Then

  40.             QueryDirectX = "DirectX 版本 低于 DirectX 9.0C"

  41.         ElseIf s < "6.0" Then

  42.             QueryDirectX = "DirectX 9.0C"

  43.         ElseIf s < "6.1" Then

  44.             QueryDirectX = "DirectX 10"

  45.         Else

  46.             QueryDirectX = "DirectX 11"

  47.         End If

  48.     End If

  49.     QueryDirectX = QueryDirectX & vbCrLf

  50.     s = objWshShell.ExpandEnvironmentStrings("%SystemRoot%\System32\XAudio2_7.dll")

  51.     If objFSO.FileExists(s) = False Then

  52.         QueryDirectX = QueryDirectX & "DirectX 最终用户运行时 2010.6 未安装"

  53.     ElseIf objFSO.GetFileVersion(s) = "9.29.1962.0" Then

  54.         QueryDirectX = QueryDirectX & "DirectX 最终用户运行时 2010.6 已安装"

  55.     Else

  56.         QueryDirectX = QueryDirectX & "DirectX 最终用户运行时 已安装 版本未知"

  57.     End If

  58.     QueryDirectX = QueryDirectX & vbCrLf

  59. End Function

  60. 

  61. Function QueryIEVer()

  62.     '读取C:\Program Files\Internet Explorer\iexplore.exe的文件版本，判断IE版本

  63.     '如果读取注册表，注意IE6~11的版本号分别是6.0  7.0  8.0  9.0  9.10  9.11

  64.     Dim s, objFSO, objWshShell

  65.     Set objFSO      = CreateObject("Scripting.FileSystemObject")

  66.     Set objWshShell = CreateObject("Wscript.Shell")

  67.     s = objWshShell.ExpandEnvironmentStrings("%ProgramFiles%\Internet Explorer\iexplore.exe")

  68.     If objFSO.FileExists(s) = False Then

  69.         QueryIEVer = "未能找到 iexplore.exe 文件，Internet Explorer 版本 查询失败"

  70.     Else

  71.         s = Split(objFSO.GetFileVersion(s), ".")

  72.         QueryIEVer = "Internet Explorer " & s(0)

  73.     End If

  74.     QueryIEVer = QueryIEVer & vbCrLf

  75. End Function

  76. 

  77. Function QueryMediaVer()

  78.     '读取C:\Program Files\Windows Media Player\wmplayer.exe的文件版本，判断MediaPlayer版本

  79.     Dim s, objFSO, objWshShell

  80.     Set objFSO      = CreateObject("Scripting.FileSystemObject")

  81.     Set objWshShell = CreateObject("Wscript.Shell")

  82.     s = objWshShell.ExpandEnvironmentStrings("%ProgramFiles%\Windows Media Player\wmplayer.exe")

  83.     If objFSO.FileExists(s) = False Then

  84.         QueryMediaVer = "未能找到 wmplayer.exe 文件，MediaPlayer 版本 查询失败"

  85.     Else

  86.         s = Split(objFSO.GetFileVersion(s), ".")

  87.         QueryMediaVer = "Media Player " & s(0)

  88.     End If

  89.     QueryMediaVer = QueryMediaVer & vbCrLf

  90. End Function

  91. 

  92. Function QueryFlashVer()

  93.     '查询HKLM\SOFTWARE\Macromedia\FlashPlayerActiveX\Version，判断Flash版本

  94.     '不要读取 "添加删除程序" 的注册表信息，比如win8.1集成Flash插件，Uninstall里面不显示

  95.     'Const HKEY_LOCAL_MACHINE = &H80000002

  96.     Dim s, objSWbemObject

  97.     Set objSWbemObject = GetObject("Winmgmts:\\.\Root\Default:StdRegProv")

  98.     objSWbemObject.GetStringValue &H80000002, "SOFTWARE\Macromedia\FlashPlayerActiveX", "Version", s

  99.     If IsNull(s) Then

  100.         QueryFlashVer = "Flash Player 版本 注册表查询 失败"

  101.     Else

  102.         QueryFlashVer = "Flash Player " & s

  103.     End If

  104.     QueryFlashVer = QueryFlashVer & vbCrLf

  105. End Function

  106. 

  107. Function QueryVC20xx()

  108.     '读取 "添加删除程序" 里的 VC++ 运行库的安装信息

  109.     '注册表：HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall

  110.     '注册表：HKLM\SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall

  111.     'Const HKEY_LOCAL_MACHINE = &H80000002

  112.     Dim s, sREG, sDis, sVer, i, j, arr, newarr, objReg

  113.     QueryVC20xx = ""

  114.     Set objReg = GetObject("Winmgmts:\\.\Root\Default:StdRegProv")

  115.     sREG = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"

  116.     objReg.EnumKey &H80000002, sREG, s

  117.     If IsNull(s) = False Then

  118.         For i = 0 To Ubound(s)

  119.             If InStr(s(i), "{") > 0 Then

  120.                 objReg.GetStringValue &H80000002, sREG & "\" & s(i), "DisplayName", sDis

  121.                 If InStr(sDis, "Microsoft Visual C++") > 0 And InStr(sDis, "Redistributable") > 0 Then

  122.                     If InStr(sDis, "Microsoft Visual C++ 2005") > 0 Then

  123.                         objReg.GetStringValue &H80000002, sREG & "\" & s(i), "DisplayVersion", sVer

  124.                         QueryVC20xx = QueryVC20xx & sDis & " " & sVer & vbCrLf

  125.                     Else

  126.                         QueryVC20xx = QueryVC20xx & sDis & vbCrLf

  127.                     End If

  128.                 End If

  129.             End If

  130.         Next

  131.     End If

  132.     sREG = "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall"

  133.     objReg.EnumKey &H80000002, sREG, s

  134.     If IsNull(s) = False Then

  135.         For i = 0 To Ubound(s)

  136.             If InStr(s(i), "{") > 0 Then

  137.                 objReg.GetStringValue &H80000002, sREG & "\" & s(i), "DisplayName", sDis

  138.                 If InStr(sDis, "Microsoft Visual C++") > 0 And InStr(sDis, "Redistributable") > 0 Then

  139.                     If InStr(sDis, "Microsoft Visual C++ 2005") > 0 Then

  140.                         objReg.GetStringValue &H80000002, sREG & "\" & s(i), "DisplayVersion", sVer

  141.                         QueryVC20xx = QueryVC20xx & sDis & " (x86) " & sVer & vbCrLf

  142.                     Else

  143.                         QueryVC20xx = QueryVC20xx & sDis & vbCrLf

  144.                     End If

  145.                 End If

  146.             End If

  147.         Next

  148.     End If

  149.     If QueryVC20xx = "" Then

  150.         QueryVC20xx = "未检测到 VC++ 运行库 安装信息" & vbCrLf

  151.         Exit Function

  152.     End If

  153.     '下面是排序，忽略大小写

  154.     arr = Split(QueryVC20xx, vbCrLf)

  155.     Redim newarr(UBound(arr))

  156.     newarr(0) = arr(0)

  157.     For i = 1 To UBound(arr)

  158.         For j = 0 To i

  159.             If Lcase(arr(i)) > Lcase(newarr(j)) Then

  160.                 s = newarr(j)

  161.                 newarr(j) = arr(i)

  162.                 arr(i) = s

  163.             End If

  164.         Next

  165.     Next

  166.     For i = 0 To UBound(arr)

  167.         arr(i) = newarr(UBound(arr) - i)

  168.     Next

  169.     '用VC替代Microsoft Visual C++，否则Win7系统显示字符数过多会自动换行

  170.     QueryVC20xx = "已安装VC运行库:" & RePlace(Join(arr, vbCrLf), "Microsoft Visual C++", "VC")

  171.     QueryVC20xx = QueryVC20xx & vbCrLf

  172. End Function

  173. 

  174. Function QueryXML()

  175.     'MSXML3  HKCR\CLSID\{F5078F32-C551-11D3-89B9-0000F81FE221}

  176.     'MSXML4  HKCR\CLSID\{88D969C0-F192-11D4-A65F-0040963251E5}

  177.     'MSXML5  HKCR\CLSID\{88D969E5-F192-11D4-A65F-0040963251E5}

  178.     'MSXML6  HKCR\CLSID\{88d96a05-f192-11d4-a65f-0040963251e5}

  179.     '读取注册表，判断对应版本的MSXML的安装信息

  180.     'Const HKEY_CLASSES_ROOT = &H80000000

  181.     Dim s, sREG, objSWbemObject

  182.     QueryXML = ""

  183.     Set objSWbemObject = GetObject("Winmgmts:\\.\Root\Default:StdRegProv")

  184.     sREG = "CLSID\{F5078F32-C551-11D3-89B9-0000F81FE221}\InProcServer32"

  185.     objSWbemObject.GetStringValue &H80000000, sREG, "", s

  186.     If IsNull(s) Then

  187.         QueryXML = QueryXML & "MSXML 3   未安装" & vbCrLf

  188.     Else

  189.         QueryXML = QueryXML & "MSXML 3   " & s & vbCrLf

  190.     End If

  191.     sREG = "CLSID\{88D969C0-F192-11D4-A65F-0040963251E5}\InProcServer32"

  192.     objSWbemObject.GetStringValue &H80000000, sREG, "", s

  193.     If IsNull(s) Then

  194.         QueryXML = QueryXML & "MSXML 4   未安装  (已被 MSXML6 替代)" & vbCrLf

  195.     Else

  196.         QueryXML = QueryXML & "MSXML 4   " & s & vbCrLf

  197.     End If

  198.     sREG = "CLSID\{88D969E5-F192-11D4-A65F-0040963251E5}\InProcServer32"

  199.     objSWbemObject.GetStringValue &H80000000, sREG, "", s

  200.     If IsNull(s) Then

  201.         QueryXML = QueryXML & "MSXML 5   未安装  (office 软件专用 )" & vbCrLf

  202.     Else

  203.         QueryXML = QueryXML & "MSXML 5   " & s & vbCrLf

  204.     End If

  205.     sREG = "CLSID\{88d96a05-f192-11d4-a65f-0040963251e5}\InProcServer32"

  206.     objSWbemObject.GetStringValue &H80000000, sREG, "", s

  207.     If IsNull(s) Then

  208.         QueryXML = QueryXML & "MSXML 6   未安装" & vbCrLf

  209.     Else

  210.         QueryXML = QueryXML & "MSXML 6   " & s & vbCrLf

  211.     End If

  212.     If QueryXML = "" Then QueryXML = "未检测到 MSXML 安装信息" & vbCrLf

  213. End Function

  214. 

  215. Function QueryNET()

  216.     'HKLM\SOFTWARE\Microsoft\NET Framework Setup\NDP

  217.     '读取注册表，判断 .NET Framework 的安装信息

  218.     'Const HKEY_LOCAL_MACHINE = &H80000002

  219.     Dim s, sREG, sVer, i, objReg

  220.     QueryNET = "已安装 .NET Framework :" & vbCrLf

  221.     Set objReg = GetObject("Winmgmts:\\.\Root\Default:StdRegProv")

  222.     sREG = "SOFTWARE\Microsoft\NET Framework Setup\NDP"

  223.     objReg.EnumKey &H80000002, sREG, s

  224.     If IsNull(s) Then

  225.         QueryNET = "未检测到 .NET Framework 安装信息" & vbCrLf

  226.         Exit Function

  227.     End If

  228.     For i = 0 To Ubound(s)

  229.         If Lcase(Left(s(i), 1)) <> "v" Then

  230.             '

  231.         ElseIf Lcase(s(i)) = "v4" Then

  232.             objReg.GetStringValue &H80000002, sREG & "\v4\Client", "Version", sVer

  233.             QueryNET = QueryNET & "v" & sVer & vbCrLf

  234.         Else

  235.             objReg.GetDWORDValue &H80000002, sREG & "\" & s(i), "SP", sVer

  236.             If IsNull(sVer) Then

  237.                 objReg.GetDWORDValue &H80000002, sREG & "\" & s(i) & "\Client", "SP", sVer

  238.                 If IsNull(sVer) Then

  239.                     QueryNET = QueryNET & s(i) & vbCrLf

  240.                 Else

  241.                     QueryNET = QueryNET & s(i) & " SP" & sVer & vbCrLf

  242.                 End If

  243.             Else

  244.                 QueryNET = QueryNET & s(i) & " SP" & sVer & vbCrLf

  245.             End If

  246.         End If

  247.     Next

  248.     QueryNET = QueryNET & vbCrLf

  249. End Function

  250. 

  251. '参考文档:

  252. 'DirectX 简介和版本         http://zh.wikipedia.org/wiki/DirectX

  253. '用VBS判断x86或x64系统      http://demon.tw/programming/vbs-x86-x64.html

  254. 'win7系统Msgbox输出自动换行 http://blogs.msdn.com/b/oldnewthing/archive/2011/06/24/10178386.aspx

  255. 'WMI 操作注册表详解         http://hi.baidu.com/350078238/item/0f62f9104e107b6e71d5e88d
复制代码




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