vbs查詢區域網內電腦的軟體和硬體列表清單
阿新 • • 發佈：2020-12-31
下面的程式碼在windows下容易報毒大家可以放心使用
'==========================================================================
'
' Date:2009/3/19
' Name: 查詢軟體和硬體列表清單
' Author:Smileruner
' www.overmcse.com
' 不支援Win2000及WinNT
'
' 3/19,添加了網絡卡過濾。
'==========================================================================
'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"),true
' wshshell.run ("%comspec% /c sc config winmgmt start= auto"),true
' wshshell.run ("%comspec% /c net start winmgmt"),0
strComputer = Inputbox("請輸入要查詢的計算機名稱","")
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,sValue
If sValue<>"" Then
sDisplayName = sValue
sDisplayName = Replace(sDisplayName,"[","(")
sDisplayName = Replace(sDisplayName,"]",")")
End If
End If
ElseIf InStr(1,"DisplayVersion",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 vbs判斷作業系統
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
For Each objItem in colItems
strOSVersion = objItem.Version
Next
wscript.echo strOSversion
select case strOSversion
case "5.2.3790"
wscript.echo "Windows Server 2003"
case "5.0.2195"
wscript.echo "Windows 2000"
case "5.1.2600"
wscript.echo "Windows XP"
case "6.0.6001"
wscript.echo "windows visita"
Case "6.1.7601"
wscript.echo "Windows Server 2008 r2"
case else
wscript.echo "i don't know"
end select到此這篇關於vbs查詢區域網內電腦的軟體和硬體列表清單的文章就介紹到這了,更多相關查詢軟體和硬體列表清單內容請搜尋我們以前的文章或繼續瀏覽下面的相關文章希望大家以後多多支援我們！