Код:
'==========================================================================
' NAME : SoftWareAudit.vbs
' AUTHOR : Павел Б.
' DATE : 29.01.2009
'
' COMMENT : используется для проведения инвентаризации программного
' обеспечения
'==========================================================================
ResultReWrite = 0 'флаг перезаписи фаила результатов 1 - перезапись 0 -нет
strPathFileResultat =".\"' "C:\" '".\" \\domenserver\datainventory$\ здесь указываем путь куда будут сохраняться отчёты по инветаризации ПО
strRazdelitel = vbTab '";"'vbTab 'для разделения полей применить символ табуляции (vbTab)
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_USERS = &H80000003
Dim strSearchKey(100)
Dim strKey_soft
Dim sSoftware(200,3), sSoftware_i 'значения массива с данными ProductId и LicenseKey, счетчика текущей строки массива
strComputer = "."
sSoftware_i = 0
strRegKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\" 'strKey
strWinkey = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"
strSearchKey(1) = "DisplayName"
strSearchKey(2) = "QuietDisplayName"
strSearchKey(3) = "InstallDate"
strSearchKey(4) = "DisplayVersion"
strSearchKey(5) = "VersionMajor"
strSearchKey(6) = "VersionMinor"
strSearchKey(7) = "EstimatedSize"
strSearchKey(8) = "ProductID"
strSearchKey(9) = "DigitalProductId"
strSearchKey(10) = "DisplayVersion"
strSearchKey(11) = "ProductName"
strDate = DateFormat(Date)
strTime = TimeFormat(Time)
strParamComputerName = "не_найдено"
strFull = ""
strMACadress = ""
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set objReg = GetObject("winmgmts://" & strComputer & "/root/default:StdRegProv")
Set colSettings = objWMIService.ExecQuery ("SELECT * FROM Win32_ComputerSystem")
Set colSoftware = objWMIService.ExecQuery ("SELECT * FROM Win32_Product")
Set colItems = objWMIService.ExecQuery ("SELECT * FROM Win32_NetworkAdapterConfiguration",,48)
Dim oWS : Set oWS = CreateObject("WScript.Shell")
Dim oFSO : Set oFSO = CreateObject("Scripting.FileSystemObject")
Dim i, ii 'просто счётчик
Dim sRegTitle, sRegKey 'переменные для работы cо строками выгруженного реестра
Dim objLineText, LineText 'переменные для загрузки информации из техтового файла (ansi)
Dim shDefKey
sRegDataSearch=Array("HKEY_CURRENT_USER","HKEY_USERS","HKEY_LOCAL_MACHINE","HKEY_CLASSES_ROOT","HKEY_CURRENT_CONFIG") ' используються при выгрузке реестра
strPath = oWS.Environment("Process")("Temp")
For i=0 To UBOUND(sRegDataSearch)
oWS.Run "regedit /e /a " & strPath & "\" & sRegDataSearch(i)& ".tmp " & sRegDataSearch(i), , True 'выгрузка реестра в файлы (ansi) для поиска
With oFSO.GetFile(strPath & "\" & sRegDataSearch(i) & ".tmp ")
objLineText = Split(.OpenAsTextStream(1, 0).Read(.Size), vbcrlf)
End With
oFSO.DeleteFile(strPath & "\" & sRegDataSearch(i) & ".tmp ") 'удаление не нужных файлов
For Each LineText In objLineText
If InStr(1,LineText,"[",1) > 0 Then
sRegTitle = LineText
End if
If InStr(1,LineText,strSearchKey(9),1) > 0 Then
If sRegTitle <> LineText Then
If (InStr(1,sRegTitle,"[") > 0) And (InStr(1,sRegTitle,"]") > 0) Then
sRegTitle = Mid(sRegTitle, InStr(1,sRegTitle,"[")+1, InStr(1,sRegTitle,"]")-InStr(1,sRegTitle,"[")-1)
GetDataReg (sRegTitle)
End If
End If
End If
Next
Erase objLineText
Next
objReg.EnumKey HKLM, strRegKey, arrSubkeys
For Each objItem in colItems
If objItem.DNSHostName <> "" Then
If strMACadress <> "" Then strMACadress = strMACadress & "," End If
strMACadress = strMACadress & objItem.MACAddress
End If
Next
For Each objComputer In colSettings
strComputerRole = "88" 'значение для нераcпределенного ПК
strUserName = objComputer.UserName
strParamComputerName = objComputer.Name
Select Case objComputer.DomainRole
Case 0 strComputerRole = "01"'"Standalone Workstation" одиночный ПК
Case 1 strComputerRole = "02"'"Member Workstation" доменный ПК
Case 2 strComputerRole = "11"'"Standalone Server" одиночный сервер
Case 3 strComputerRole = "12"'"Member Server" - сервер домена
Case 4 strComputerRole = "13"'"Backup Domain Controller" - Сервер BDC
Case 5 strComputerRole = "14"'"Primary Domain Controller" - Сервер PDC
End Select
Next
If ResultReWrite = 0 Then
strFileSoftwareAudit = strPathFileResultat & "SoftwareAudit_" & strParamComputerName & "_" & strDATE & strTime & ".txt"
Else
strFileSoftwareAudit = strPathFileResultat & "SoftwareAudit_" & strParamComputerName & ".txt"
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.CreateTextFile(strFileSoftwareAudit, True)
Set objReg = GetObject("winmgmts://" & strComputer & "/root/default:StdRegProv")
On Error Resume Next
For Each objOS in GetObject("winmgmts:").InstancesOf ("Win32_OperatingSystem")
strFull = _
strComputerRole & _
strRazdelitel & strParamComputerName & _
strRazdelitel & strMACadress & _
strRazdelitel & strUserName & _
strRazdelitel & objOS.Caption & _
strRazdelitel & objOS.Version & _
strRazdelitel & Mid(objOS.InstallDate,1,8) & _
strRazdelitel & objOS.SerialNumber & _
strRazdelitel & GetKey(oWS.RegRead("HKLM\" & strWinkey & "\" & strSearchKey(9)))
If strFull <> "" Then objTextFile.WriteLine strFull End If
Next
'назначение ПК (01,02 - ПК, 11,12,13,14 - сервер)
'сетевое имя ПК
'MAC адрес ПК
'пользователь ПК (текущий на момент аудита)
'лицензионное наименование ПО
'версия ПО
'дата установки ПО
'PID ПО
'лицензионный ключ ПО
objReg.EnumKey HKEY_LOCAL_MACHINE, strRegKey, arrSubkeys
For Each strSubkey In arrSubkeys
If objReg.GetStringValue(HKEY_LOCAL_MACHINE, strRegKey & strSubkey, strSearchKey(1), strValue1) <> 0 Then
objReg.GetStringValue HKEY_LOCAL_MACHINE, strRegKey & strSubkey, strSearchKey(2), strValue1
End If
objReg.GetStringValue HKEY_LOCAL_MACHINE, strRegKey & strSubkey, strSearchKey(3), strValue2
objReg.GetDWORDValue HKEY_LOCAL_MACHINE, strRegKey & strSubkey, strSearchKey(5), intValue3
objReg.GetDWORDValue HKEY_LOCAL_MACHINE, strRegKey & strSubkey, strSearchKey(6), intValue4
objReg.GetDWORDValue HKEY_LOCAL_MACHINE, strRegKey & strSubkey, strSearchKey(7), intValue5
objReg.GetStringValue HKEY_LOCAL_MACHINE, strRegKey & strSubkey, strSearchKey(8), intValue6
objReg.GetStringValue HKEY_LOCAL_MACHINE, strRegKey & strSubkey, strSearchKey(10), intValue10
If strValue1 <> "" Then
For i = 0 To sSoftware_i
If strValue1 = sSoftware(i,3) Or intValue6 = sSoftware(i,1) Then
strKey_soft = sSoftware(i,2)
intValue6 = sSoftware(i,1)
End If
Next
End If
If intValue10 = "" Then intValue10 = intValue3 & "." & intValue4 End If
strFull = _
strComputerRole & _
strRazdelitel & strParamComputerName & _
strRazdelitel & strMACadress & _
strRazdelitel & strUserName & _
strRazdelitel & strValue1 & _
strRazdelitel & intValue10 & _
strRazdelitel & strValue2 & _
strRazdelitel & intValue6 & _
strRazdelitel & strKey_soft
If strValue1 <> "" Then objTextFile.WriteLine strFull End If
strKey_soft = ""
intValue6 = ""
'назначение ПК (01,02 - ПК, 11,12,13,14 - сервер)
'сетевое имя ПК
'MAC адрес ПК
'пользователь ПК (текущий на момент аудита)
'лицензионное наименование ПО
'версия ПО
'дата установки ПО
'PID ПО
'лицензионный ключ ПО
Next
objTextFile.Close
Cleanup()
Sub Cleanup()
Set oWS = Nothing
Set oFSO = Nothing
WScript.Quit
End Sub
Function GetKey(rpk)
Dim szPossibleChars, dwAccumulator, j, i, szProductKey
Const rpkOffset=52:i=28
szPossibleChars="BCDFGHJKMPQRTVWXY2346789"
Do 'Rep1
dwAccumulator=0 : j=14
Do
dwAccumulator=dwAccumulator*256
dwAccumulator=rpk(j+rpkOffset)+dwAccumulator
rpk(j+rpkOffset)=(dwAccumulator\24) and 255
dwAccumulator=dwAccumulator Mod 24
j=j-1
Loop While j>=0
i=i-1 : szProductKey=mid(szPossibleChars,dwAccumulator+1,1)&szProductKey
if (((29-i) Mod 6)=0) And (i<>-1) then
i=i-1 : szProductKey="-"&szProductKey
End If
Loop While i>=0 'Goto Rep1
GetKey=szProductKey
End Function
Function FormatNum(NumVal)
strNum = Trim(NumVal)
If Len(strNum) = 1 Then strNum = "0" + strNum
FormatNum = strNum
End Function
Function DateFormat(DateVal)
strNY = FormatNum(Year(DateVal))
strNM = FormatNum(Month(DateVal))
strND = FormatNum(Day(DateVal))
'DateFormat = strNY + "_" + strNM + "_" + strND
DateFormat = strNY + strNM + strND
End Function
Function TimeFormat(TimeVal)
strNH = FormatNum(Hour(TimeVal))
strNMin = FormatNum(Minute(TimeVal))
strNS = FormatNum(Second(TimeVal))
'TimeFormat = strNH + "_" + strNMin + "_" + strNS
TimeFormat = strNH + strNMin + strNS
End Function
Function GetDataReg (ssRegTitle)
Dim sID_soft, sKey_soft, sName_soft
sID_soft = ""
sKey_soft = ""
sName_soft = ""
sRegTitle = ssRegTitle
Select Case Mid(sRegTitle, 1, InStr(1,sRegTitle,"\")-1)
Case "HKEY_CURRENT_USER"
shDefKey=HKEY_CURRENT_USER
Case "HKEY_USERS"
shDefKey=HKEY_USERS
Case "HKEY_LOCAL_MACHINE"
shDefKey=HKEY_LOCAL_MACHINE
Case "HKEY_CLASSES_ROOT"
shDefKey=HKEY_CLASSES_ROOT
Case "HKEY_CURRENT_CONFIG"
shDefKey=HKEY_CURRENT_CONFIG
End Select
If objReg.EnumValues (shDefKey, Mid(sRegTitle, InStr(1,sRegTitle,"\")+1, Len(sRegTitle)-InStr(1,sRegTitle,"\")), arrEntryNames, arrValueTypes) = 0 Then
For ii=0 To UBound(arrEntryNames)
If (LCase(arrEntryNames(ii)) = LCase(strSearchKey(8))) And (arrValueTypes(ii)= 1) Then
sID_soft = oWS.RegRead(sRegTitle & "\" & strSearchKey(8))
End If
If (LCase(arrEntryNames(ii)) = LCase(strSearchKey(9))) And (arrValueTypes(ii)= 3) Then
sKey_soft = GetKey(oWS.RegRead(sRegTitle & "\" & strSearchKey(9)))
End If
If (LCase(arrEntryNames(ii)) = LCase(strSearchKey(11))) And (arrValueTypes(ii)= 1) Then
sName_soft = oWS.RegRead(sRegTitle & "\" & strSearchKey(11))
End If
Next
End If
If (sID_soft <> "") And (sKey_soft <> "") Then
sSoftware(sSoftware_i,1) = sID_soft
sSoftware(sSoftware_i,2) = sKey_soft
sSoftware(sSoftware_i,3) = sName_soft
sSoftware_i = sSoftware_i + 1
End If
End Function
