查询软件和硬件列表清单[将文章里代码另存为 list.vbs,双击运行就会出现一个html页面]
2014-04-24 10:09
609 查看
'==========================================================================
' Name: 查询软件和硬件列表清单
' 不支持Win2000及WinNT'
'==========================================================================
'on error resume Next
const HKEY_LOCAL_MACHINE = &H80000002
const UNINSTALL_ROOT = "Software\Microsoft\Windows\CurrentVersion\Uninstall"
const REG_SZ = 1
'==========================================================================
'Set wshshell=wscript.createobject("wscript.shell")
' wshshell.run ("%comspec% /c regsvr32 /s scrrun.dll"),0,true
' wshshell.run ("%comspec% /c sc config winmgmt start= auto"),0,true
' wshshell.run ("%comspec% /c net start winmgmt"),0
strIPPattern = "((2[0-4]\d|25[0-5]|1?\d\d?)\.){3}(2[0-4]\d|25[0-5]|1?\d\d?)"
Set objNet = createobject("Wscript.Network")
Set objRegExp = New RegExp
objregexp.Pattern = strIPPattern
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set IPConfigSet = objWMIService.ExecQuery _
("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled=TRUE")
For Each IPConfig in IPConfigSet
If Not IsNull(IPConfig.IPAddress) Then
For i=LBound(IPConfig.IPAddress) to UBound(IPConfig.IPAddress)
If InStr(IPConfig.Caption(i),"VMware") = 0 And InStr(IPConfig.Caption(i),"Microsoft") = 0 Then
If InStr(IPConfig.Caption(i),"169.254") = 0 And InStr(IPConfig.Caption(i),"0.0.0.0") = 0 Then
If objregexp.Test(IPConfig.IPAddress(i)) = True Then
strIP = IPConfig.IPAddress(i)
End If
End If
End If
Next
End If
Next
strUser = objnet.UserName
Set objNetwork = CreateObject("WScript.Network")
'==========================================================================
strComputer = objNetwork.ComputerName
If strComputer = "" then
Wscript.Echo "未输入值或用戶取消,查询退出。"
Wscript.Quit
End If
Set objswbemlocator = createobject("wbemscripting.swbemlocator")
Set objswbemservices = objswbemlocator.connectserver(strComputer, "root\cimv2")
If Err.number <> 0 then
Wscript.Echo "目目标计算机无法连接。错误的计算机名,或目標计算机启用了防火墻,RPC服務不可用。"
Err.number.clear
Wscript.Quit
End If
'swbemservices.security_.impersonationleobjvel = 3
Set fso=createobject("scripting.filesystemobject")
FileDate = Replace(date(), "/", "-")
resoultfilepath= strComputer & FileDate & ".html"
Set resultFile= fso.createtextfile(resoultfilepath,,true)
HtmlWriteHead()
'Html文檔開始
TableHead strComputer,"硬件清单"
'Html表格開始
OsWrite()
'写入操作系統信息
BoardWrite()
'写入主板信息
CpuWrite()
'写入CPU信息
MemoryWrite()
'写入內存信息
HarddiskWrite()
'写入硬盤信息
CdromWrite()
'写入CDROM信息
VideoWrite()
'写入显示卡信息
NetcardWrite()
'写入网卡卡信息
TableEnd()
'Html表格結尾
TableHead strComputer,"软件清单"
'Html表格開頭
Softlist()
'写入软件件信息
TableEnd()
'Html表格結尾
HtmlWriteEnd()
'Html文檔結束
ResultFile.close
Wscript.Echo "查詢完成!"
'=========以下是函數列表==========
Function OsWrite()
'函數,写入操作系統信息
Set colOs =objswbemservices.execquery("select * from win32_operatingsystem",,48)
For Each Ositem In colOs
oscaption = Ositem.caption
OsVersion = oscaption & Ositem.version
WriteTable "操作系統",OsVersion
Next
End Function
Function BoardWrite()
'函數,写入主板信息
Set colBoard = objswbemservices.execquery("select * from win32_baseboard")
For Each Bditem In colBoard
boardname = Bditem.product
WriteTable "主板",boardname
Next
End Function
Function CpuWrite()
'函數,写入CPU信息
Set colCpu =objswbemservices.execquery("select * from win32_processor")
For Each item in colCpu
cpuname = (trim(item.name))
WriteTable "中央处理器",cpuname
Next
End Function
Function MemoryWrite()
'函數,写入內存信息
mtotal = 0
num = 0
mill = 0
Set colMemory = objswbemservices.execquery("select * from win32_physicalmemory",,48)
For Each objitem In colMemory
mill = objitem.capacity/1048576
WriteTable "单根內存容量",mill & "M"
mtotal = mtotal+mill
num = num + 1
Next
WriteTable "总计內存",num & "条" & "一共" & mtotal & "M"
End Function
Function HarddiskWrite()
'函數,写入硬盘信息
Set colDisk = objswbemservices.execquery("select * from win32_diskdrive", , 48)
For Each objitem In colDisk
diskname= objitem.caption
disksize= fix(objitem.size/1073741824)
WriteTable "硬盘",diskname & " 容量:" & disksize & "G"
Next
End Function
Function CdromWrite()
'函數,写入CDROM信息
Set colCdrom = objswbemservices.execquery("select * from win32_cdromdrive where scsitargetid=0")
For Each objitem In colCdrom
cdname = objitem.name
WriteTable "光驱",cdname
Next
End Function
Function videoWrite()
'函數,写入显示卡信息
Set colVideo = objswbemservices.execquery("select * from win32_videocontroller", , 48)
For Each objitem in colVideo
videoname = (trim(objitem.caption) & (objitem.videomodedescription))
WriteTable "显示卡",videoname
Next
End Function
Function netcardWrite()
'函數,查询网卡信息
Set colNetcards = objswbemservices.execquery("select * from win32_networkadapter")
For Each objNetcard in colNetcards
If Not IsNull(objNetcard.NetConnectionID) Then
NetCardName = objNetcard.productname
WriteTable "网卡名称",NetCardName
If objNetcard.NetConnectionStatus = 2 Then
NetCardMac = objNetcard.macaddress
WriteTable "网卡Mac",NetCardMac
strQueryIp ="select * from win32_networkadapterconfiguration" &_
" where IPEnabled = true" &_
" and macaddress = '" & objNetcard.macaddress & "'"
Set colNetcardCfgs = objswbemservices.execquery(strQueryIp)
For Each objNetcardCfg in colNetcardCfgs
For Each CfgAdrress in objNetcardCfg.IPAddress
IpAdrress = CfgAdrress
WriteTable "IP地址",IpAdrress
Next
Next
Else
NetCardMac = "網卡被禁用或未連接。"
WriteTable "網卡Mac",NetCardMac
IpAdrress = "網卡被禁用或未連接。"
WriteTable "IP地址",IpAdrress
End If
End if
Next
End Function
Function softlist()
'函數,写入软件信息
Set StdOut = WScript.StdOut
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &_
strComputer & "\root\default:StdRegProv")
strKeyPath = UNINSTALL_ROOT
oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
For Each strSubKey In arrSubKeys
If NotHotfix(strSubKey) Then
SoftNameAndVersion = getProgNameAndVersion(oReg,strKeyPath & "\" & strSubKey)
If SoftNameAndVersion<>"0" Then
WriteTable "软件",SoftNameAndVersion
End If
End If
Next
End Function
Function NotHotfix(sSubKey)
If Left(sSubkey,2) = "KB" And len(sSubkey) = 8 Then
NotHotfix = 0
Else NotHotfix = 1
End if
End Function
Function getProgNameAndVersion(oReg,sKeyRoot)
Dim sKeyValuesAry, iKeyTypesAry, nCnt, sValue, sDisplayName, sDisplayVersion
oReg.EnumValues HKEY_LOCAL_MACHINE, sKeyRoot, sKeyValuesAry, iKeyTypesAry
If NOT IsArray(sKeyValuesAry) Then
getProgNameAndVersion = 0
Exit Function
End If
For nCnt = 0 To UBound(sKeyValuesAry)
If InStr(1, sKeyValuesAry(nCnt), "DisplayName", vbTextCompare) Then
If iKeyTypesAry(nCnt) = REG_SZ Then
oReg.GetStringValue HKEY_LOCAL_MACHINE, sKeyRoot, sKeyValuesAry(nCnt), sValue
If sValue<>"" Then
sDisplayName = sValue
sDisplayName = Replace(sDisplayName, "[", "(")
sDisplayName = Replace(sDisplayName, "]", ")")
End If
End If
ElseIf InStr(1, sKeyValuesAry(nCnt), "DisplayVersion", vbTextCompare) Then
If iKeyTypesAry(nCnt) = REG_SZ Then
oReg.GetStringValue HKEY_LOCAL_MACHINE, sKeyRoot, sKeyValuesAry(nCnt), sValue
If sValue<>"" Then sDisplayVersion = sValue
End If
End If
If (sDisplayName<>"") AND (sDisplayVersion<>"") Then
getProgNameAndVersion = sDisplayName & " --版本号: " & sDisplayVersion
Exit Function
Else getProgNameAndVersion = 0
End If
Next
If sDisplayName<>"" Then
getProgNameAndVersion = sDisplayName
Exit Function
End If
End Function
Function WriteTable(caption,value)
'函數,將数据写入HTML單元格
resultFile.Writeline "<tr>"
resultFile.Writeline "<td align=""left"" width=""30%"" height=""25"" bgcolor=""#ffffff"" scope=""row""> " & caption & "</td>"
resultFile.Writeline "<td bgcolor=""#ffffff""> " & value & "</td>"
resultFile.Writeline "</tr>"
End Function
Function HtmlWriteHead()
'函數,写入THML文件頭
resultFile.Writeline "<html>"
resultFile.Writeline "<head>"
resultFile.Writeline "<title>软硬件配置清单</title>"
resultFile.Writeline "</head>"
resultFile.Writeline "<body>"
End Function
Function HtmlWriteEnd()
'函數,写入Html文件尾
resultFile.Writeline "</body>"
resultFile.Writeline "</html>"
End Function
Function TableHead(pcname,str)
'函數,写入Html表格结尾
resultFile.Writeline "<h3>" & pcname & str & " -- date:"&now()&" </h3>" & VbCrLf
resultFile.Writeline "<table width=""90%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""1"" bgcolor=""#0000ff"">"
resultFile.Writeline "<tr>"
resultFile.Writeline "<th width=""30%"" height=""25"" bgcolor=""#ffffff"" scope=""col"">资产类型</th>"
resultFile.Writeline "<th bgcolor=""#ffffff"" scope=""col"">查询结果值</th>"
resultFile.Writeline "</tr>"
strstyle = "<th width=""30%"" height=""25"" bgcolor=""#ffffff"" scope=""row"">"
End Function
Function TableEnd()
'函數,Html表格结尾
resultFile.Writeline "</table>"
End Function
' Name: 查询软件和硬件列表清单
' 不支持Win2000及WinNT'
'==========================================================================
'on error resume Next
const HKEY_LOCAL_MACHINE = &H80000002
const UNINSTALL_ROOT = "Software\Microsoft\Windows\CurrentVersion\Uninstall"
const REG_SZ = 1
'==========================================================================
'Set wshshell=wscript.createobject("wscript.shell")
' wshshell.run ("%comspec% /c regsvr32 /s scrrun.dll"),0,true
' wshshell.run ("%comspec% /c sc config winmgmt start= auto"),0,true
' wshshell.run ("%comspec% /c net start winmgmt"),0
strIPPattern = "((2[0-4]\d|25[0-5]|1?\d\d?)\.){3}(2[0-4]\d|25[0-5]|1?\d\d?)"
Set objNet = createobject("Wscript.Network")
Set objRegExp = New RegExp
objregexp.Pattern = strIPPattern
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set IPConfigSet = objWMIService.ExecQuery _
("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled=TRUE")
For Each IPConfig in IPConfigSet
If Not IsNull(IPConfig.IPAddress) Then
For i=LBound(IPConfig.IPAddress) to UBound(IPConfig.IPAddress)
If InStr(IPConfig.Caption(i),"VMware") = 0 And InStr(IPConfig.Caption(i),"Microsoft") = 0 Then
If InStr(IPConfig.Caption(i),"169.254") = 0 And InStr(IPConfig.Caption(i),"0.0.0.0") = 0 Then
If objregexp.Test(IPConfig.IPAddress(i)) = True Then
strIP = IPConfig.IPAddress(i)
End If
End If
End If
Next
End If
Next
strUser = objnet.UserName
Set objNetwork = CreateObject("WScript.Network")
'==========================================================================
strComputer = objNetwork.ComputerName
If strComputer = "" then
Wscript.Echo "未输入值或用戶取消,查询退出。"
Wscript.Quit
End If
Set objswbemlocator = createobject("wbemscripting.swbemlocator")
Set objswbemservices = objswbemlocator.connectserver(strComputer, "root\cimv2")
If Err.number <> 0 then
Wscript.Echo "目目标计算机无法连接。错误的计算机名,或目標计算机启用了防火墻,RPC服務不可用。"
Err.number.clear
Wscript.Quit
End If
'swbemservices.security_.impersonationleobjvel = 3
Set fso=createobject("scripting.filesystemobject")
FileDate = Replace(date(), "/", "-")
resoultfilepath= strComputer & FileDate & ".html"
Set resultFile= fso.createtextfile(resoultfilepath,,true)
HtmlWriteHead()
'Html文檔開始
TableHead strComputer,"硬件清单"
'Html表格開始
OsWrite()
'写入操作系統信息
BoardWrite()
'写入主板信息
CpuWrite()
'写入CPU信息
MemoryWrite()
'写入內存信息
HarddiskWrite()
'写入硬盤信息
CdromWrite()
'写入CDROM信息
VideoWrite()
'写入显示卡信息
NetcardWrite()
'写入网卡卡信息
TableEnd()
'Html表格結尾
TableHead strComputer,"软件清单"
'Html表格開頭
Softlist()
'写入软件件信息
TableEnd()
'Html表格結尾
HtmlWriteEnd()
'Html文檔結束
ResultFile.close
Wscript.Echo "查詢完成!"
'=========以下是函數列表==========
Function OsWrite()
'函數,写入操作系統信息
Set colOs =objswbemservices.execquery("select * from win32_operatingsystem",,48)
For Each Ositem In colOs
oscaption = Ositem.caption
OsVersion = oscaption & Ositem.version
WriteTable "操作系統",OsVersion
Next
End Function
Function BoardWrite()
'函數,写入主板信息
Set colBoard = objswbemservices.execquery("select * from win32_baseboard")
For Each Bditem In colBoard
boardname = Bditem.product
WriteTable "主板",boardname
Next
End Function
Function CpuWrite()
'函數,写入CPU信息
Set colCpu =objswbemservices.execquery("select * from win32_processor")
For Each item in colCpu
cpuname = (trim(item.name))
WriteTable "中央处理器",cpuname
Next
End Function
Function MemoryWrite()
'函數,写入內存信息
mtotal = 0
num = 0
mill = 0
Set colMemory = objswbemservices.execquery("select * from win32_physicalmemory",,48)
For Each objitem In colMemory
mill = objitem.capacity/1048576
WriteTable "单根內存容量",mill & "M"
mtotal = mtotal+mill
num = num + 1
Next
WriteTable "总计內存",num & "条" & "一共" & mtotal & "M"
End Function
Function HarddiskWrite()
'函數,写入硬盘信息
Set colDisk = objswbemservices.execquery("select * from win32_diskdrive", , 48)
For Each objitem In colDisk
diskname= objitem.caption
disksize= fix(objitem.size/1073741824)
WriteTable "硬盘",diskname & " 容量:" & disksize & "G"
Next
End Function
Function CdromWrite()
'函數,写入CDROM信息
Set colCdrom = objswbemservices.execquery("select * from win32_cdromdrive where scsitargetid=0")
For Each objitem In colCdrom
cdname = objitem.name
WriteTable "光驱",cdname
Next
End Function
Function videoWrite()
'函數,写入显示卡信息
Set colVideo = objswbemservices.execquery("select * from win32_videocontroller", , 48)
For Each objitem in colVideo
videoname = (trim(objitem.caption) & (objitem.videomodedescription))
WriteTable "显示卡",videoname
Next
End Function
Function netcardWrite()
'函數,查询网卡信息
Set colNetcards = objswbemservices.execquery("select * from win32_networkadapter")
For Each objNetcard in colNetcards
If Not IsNull(objNetcard.NetConnectionID) Then
NetCardName = objNetcard.productname
WriteTable "网卡名称",NetCardName
If objNetcard.NetConnectionStatus = 2 Then
NetCardMac = objNetcard.macaddress
WriteTable "网卡Mac",NetCardMac
strQueryIp ="select * from win32_networkadapterconfiguration" &_
" where IPEnabled = true" &_
" and macaddress = '" & objNetcard.macaddress & "'"
Set colNetcardCfgs = objswbemservices.execquery(strQueryIp)
For Each objNetcardCfg in colNetcardCfgs
For Each CfgAdrress in objNetcardCfg.IPAddress
IpAdrress = CfgAdrress
WriteTable "IP地址",IpAdrress
Next
Next
Else
NetCardMac = "網卡被禁用或未連接。"
WriteTable "網卡Mac",NetCardMac
IpAdrress = "網卡被禁用或未連接。"
WriteTable "IP地址",IpAdrress
End If
End if
Next
End Function
Function softlist()
'函數,写入软件信息
Set StdOut = WScript.StdOut
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &_
strComputer & "\root\default:StdRegProv")
strKeyPath = UNINSTALL_ROOT
oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
For Each strSubKey In arrSubKeys
If NotHotfix(strSubKey) Then
SoftNameAndVersion = getProgNameAndVersion(oReg,strKeyPath & "\" & strSubKey)
If SoftNameAndVersion<>"0" Then
WriteTable "软件",SoftNameAndVersion
End If
End If
Next
End Function
Function NotHotfix(sSubKey)
If Left(sSubkey,2) = "KB" And len(sSubkey) = 8 Then
NotHotfix = 0
Else NotHotfix = 1
End if
End Function
Function getProgNameAndVersion(oReg,sKeyRoot)
Dim sKeyValuesAry, iKeyTypesAry, nCnt, sValue, sDisplayName, sDisplayVersion
oReg.EnumValues HKEY_LOCAL_MACHINE, sKeyRoot, sKeyValuesAry, iKeyTypesAry
If NOT IsArray(sKeyValuesAry) Then
getProgNameAndVersion = 0
Exit Function
End If
For nCnt = 0 To UBound(sKeyValuesAry)
If InStr(1, sKeyValuesAry(nCnt), "DisplayName", vbTextCompare) Then
If iKeyTypesAry(nCnt) = REG_SZ Then
oReg.GetStringValue HKEY_LOCAL_MACHINE, sKeyRoot, sKeyValuesAry(nCnt), sValue
If sValue<>"" Then
sDisplayName = sValue
sDisplayName = Replace(sDisplayName, "[", "(")
sDisplayName = Replace(sDisplayName, "]", ")")
End If
End If
ElseIf InStr(1, sKeyValuesAry(nCnt), "DisplayVersion", vbTextCompare) Then
If iKeyTypesAry(nCnt) = REG_SZ Then
oReg.GetStringValue HKEY_LOCAL_MACHINE, sKeyRoot, sKeyValuesAry(nCnt), sValue
If sValue<>"" Then sDisplayVersion = sValue
End If
End If
If (sDisplayName<>"") AND (sDisplayVersion<>"") Then
getProgNameAndVersion = sDisplayName & " --版本号: " & sDisplayVersion
Exit Function
Else getProgNameAndVersion = 0
End If
Next
If sDisplayName<>"" Then
getProgNameAndVersion = sDisplayName
Exit Function
End If
End Function
Function WriteTable(caption,value)
'函數,將数据写入HTML單元格
resultFile.Writeline "<tr>"
resultFile.Writeline "<td align=""left"" width=""30%"" height=""25"" bgcolor=""#ffffff"" scope=""row""> " & caption & "</td>"
resultFile.Writeline "<td bgcolor=""#ffffff""> " & value & "</td>"
resultFile.Writeline "</tr>"
End Function
Function HtmlWriteHead()
'函數,写入THML文件頭
resultFile.Writeline "<html>"
resultFile.Writeline "<head>"
resultFile.Writeline "<title>软硬件配置清单</title>"
resultFile.Writeline "</head>"
resultFile.Writeline "<body>"
End Function
Function HtmlWriteEnd()
'函數,写入Html文件尾
resultFile.Writeline "</body>"
resultFile.Writeline "</html>"
End Function
Function TableHead(pcname,str)
'函數,写入Html表格结尾
resultFile.Writeline "<h3>" & pcname & str & " -- date:"&now()&" </h3>" & VbCrLf
resultFile.Writeline "<table width=""90%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""1"" bgcolor=""#0000ff"">"
resultFile.Writeline "<tr>"
resultFile.Writeline "<th width=""30%"" height=""25"" bgcolor=""#ffffff"" scope=""col"">资产类型</th>"
resultFile.Writeline "<th bgcolor=""#ffffff"" scope=""col"">查询结果值</th>"
resultFile.Writeline "</tr>"
strstyle = "<th width=""30%"" height=""25"" bgcolor=""#ffffff"" scope=""row"">"
End Function
Function TableEnd()
'函數,Html表格结尾
resultFile.Writeline "</table>"
End Function
相关文章推荐
- Javascript 用本页面文本域中的HTML代码打开一个空白窗口来运行
- 一个显示日历的页面代码(后缀格式为html)
- 直接双击页面元素进行修改的HTML代码
- 一个页面搞定几乎所有的列表需求的实现思路和一点代码。
- 最近设计了一个生成asp代码的程序,同时也可以作为数据库管理查询的软件,发两张图,等完全做好了,给大家共享!
- 在Action中查询出SQL SERVER表的数据,返回一个list。怎么在JSP页面中使用Struts标签,显示出表中的内容?(转)
- ASP.NET Aries 入门开发教程3:开发一个列表页面及操控查询区 推荐
- 最近设计了一个生成asp代码的程序,同时也可以作为数据库管理查询的软件,有兴趣的朋友可以去下载!
- 开源DIGG软件PBDigg2.0的修改(八):解决搜索文章结果出现代码的问题。
- .html的页面的内容没有显示,只因为少了一个成对出现的标签
- j2ee的web项目,在浏览器中发起一个该项目中html页面的绝对地址,也是发起的一个http url请求,请求的响应报文的结果就是该html页面的所有html代码
- 抓取天涯文章的蜘蛛代码,刚经过更新(因为天涯页面HTML代码变化)
- python - 列表分组技巧 #写出一段 Python 代码,实现分组一个 list 里面的元素,如 [1,2,3,...100]变成 [[1,2,3],[4,5,6]....]
- HTML列表(list),这个比较重要的一个知识!
- 用C语言开发一个BT下载软件 (四) ------ 代码实现-3-出错处理模块和运行日志模块
- 刚才访问OS发现链接错误,然后出现了一个每过5S就重新连接的页面,代码如下
- 一例由于用redis缓存一张表到内存导致列表页面在搜索查询的时候出现未将对象引用设置到对象的实例问题的解决
- 关于Hibernate中fatch=eager的bag集合(一个java List)使用Criteria查询出现重复记录的问题
- ASP.NET Aries 入门开发教程3:开发一个列表页面及操控查询区
- 浏览ASP页面,出现的错误“操作必须使用一个可更新的查询”