VBS. Инвентаризация железа.

24.12.2019

В сети довольно много примеров использования VBS для проведения инвентаризации компьютеров, но ни один из них не подошел мне в качестве готового варианта для использования.
По этой причине, изучив как они работают, мне пришлось на базе доступных в сети примеров, создать свой, удовлетворяющий на все 100% моё видение процесса инвентаризации.

Рассмотрев известный скрипт Павла Железнова и несколько других, мне удалось собрать код, который инвентаризирует не только начинку системного блока, но и мониторы, и принтеры.
Конечно получить серийный номер принтера не удалось, отличии от всего остального, поэтому исключил вывод серийных номеров везде.

Ниже приведен полностью рабочий код VBS.

[code]
'режим работы
Const SILENT = True 'режим отчета о локальном компьютере без вывода диалогов
'где сохранять отчет по принтерам
'Const DATA_DIR = "" 
 Const DATA_DIRPRN = "\\сервер\Invent$\printers\"  'сетевой ресурс + "\" в конце
 Const DATA_DIRPC = "\\сервер\Invent$\computers\"
'прочее
Const TITLE = "Инвентаризация компьютеров и принтеров" 'заголовок диалоговых окон
Const DATA_EXT = ".csv" 'расширение файла отчета
Const HEAD_LINE = True 'выводить заголовки в первой строке CSV-файла
'не завершать скрипт аварийно
On Error Resume Next
'== ВЫПОЛНЕНИЕ
'объект для доступа к файловой системе
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
'объект WMI
Dim wmio
Dim tfPRN 'файл отчета по принтерам
Dim tf    'файл отчета по компам
'узнать имя локального компьютера
Dim nwo, comp
Set nwo = CreateObject("WScript.Network")
comp = LCase(nwo.ComputerName)
function ipLocal()
xz=""
dim strComputer,objWMIService,IPConfigSet,IPConfig,i,ip
Set WSHNetwork = CreateObject("WScript.Network")
ComputerName=WSHNetwork.ComputerName
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set IPConfigSet = objWMIService.ExecQuery("Select IPAddress from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")
'определение своего ip
For Each IPConfig in IPConfigSet
If Not IsNull(IPConfig.IPAddress) Then
For i=LBound(IPConfig.IPAddress) to UBound(IPConfig.IPAddress)
if len(IPConfig.IPAddress(i))<16 then
if IPConfig.IPAddress(i)<>xz  then
xz=IPConfig.IPAddress(i)
 If (inStr(xz, "192.168.")=0) then
 'эта проверка стоит для получения IP машины, т.к. мы не используем этот диапазон
 ip = IPConfig.IPAddress(i)
end If
  end If
     end if
Next
   End If
      Next
ipLocal = ip 
End function
'провести инвентаризацию
'============раздел инвентаризация принтеров================
If Len(comp) > 0 Then InventPRN(comp)
'если ошибка
If Len(Err.Description) > 0 Then _
   If Not SILENT Then MsgBox comp & vbCrLf & "Ошибка:" & vbCrLf & Err.Description, vbExclamation, TITLE
'сохранение отчета с указанным именем
Sub InventPRN(compname)
  Set wmio = GetObject("WinMgmts:{impersonationLevel=impersonate}!\\" & compname & "\Root\CIMV2")
  'некоторые WMI-классы поддерживаются не во всех версиях Windows
  Dim build
  build = BuildVersion()
'файл отчета по принтерам
  Set tfPRN = fso.CreateTextFile(DATA_DIRPRN & compname & "_prn" & DATA_EXT, True)
'первая строка - заголовки
If HEAD_LINE Then tfPRN.WriteLine "Дата проверки;Тип принтера;Номер 

экземпляра;ПривязкаПК;Модель;Порт;ShareName;Location;Direct;Shared;WorkOffline"
   If build >= 2600 Then
   LogPRN "Win32_Printer", _
   "SystemName,Name,PortName,ShareName,Location,Direct,Shared,WorkOffline", "(Local = True OR Network = False) AND (PortName LIKE '%USB%' OR 

PortName LIKE '%LPT%')", _
   "Локальный принтер", _
   "SystemName,Наименование,Порт,Сетевое имя,Location,Direct,Shared,WorkOffline"
                         End If
    If build >= 2600 Then
    LogPRN "Win32_Printer", _
    "SystemName,Name,PortName,ShareName,Location,Direct,Shared,WorkOffline", "(PortName LIKE '%10.%' OR PortName LIKE '%192.%' OR PortName 

LIKE '%\\%')", _
    "Сетевой принтер", _
    "SystemName,Наименование,Порт,Сетевое имя,Location,Direct,Shared,WorkOffline"
	        End If
'закрыть файл 
tfPRN.Close
End Sub
'Наполнение файла отчета данными по принтерам
Sub LogPRN(from, sel, where, sect, param)
Const RETURN_IMMEDIATELY = 16
Const FORWARD_ONLY = 32
Dim query, cls, item, prop
query = "Select " & sel & " From " & from
If Len(where) > 0 Then query = query & " Where " & where
Set cls = wmio.ExecQuery(query,, RETURN_IMMEDIATELY + FORWARD_ONLY)
Dim props, names, num, value
props = Split(sel, ",")
names = Split(param, ",")
num = 1 'номер экземпляра
For Each item In cls
tfPRN.Write Date & ";"
tfPRN.Write sect & ";"
tfPRN.Write num & ";"
For i = 0 To UBound(props)
'взять значение
Set prop = item.Properties_(props(i))
value = prop.Value
'без проверки на Null возможнен вылет с ошибкой
If IsNull(value) Then  value = "-"    End If
'вывести в файл непустое значение, заменить спецсимвол ";"
value = Trim(Replace(value, ";", "_"))
If Len(value) > 0 Then tfPRN.Write value & ";"
	Next 'i
	'перейти к следующему экземпляру
	num = num + 1
	tfPRN.WriteLine  
	Next 'item
End Sub
'============= конец раздела инвентаризация принтеров===============
'
'============== раздел инвентаризация компов ======================
If Len(comp) > 0 Then InventPC(comp)
'если ошибка
If Len(Err.Description) > 0 Then _
If Not SILENT Then MsgBox comp & vbCrLf & "Ошибка:" & vbCrLf & Err.Description, vbExclamation, TITLE
Sub InventPC(compname)
Set wmio = GetObject("WinMgmts:{impersonationLevel=impersonate}!\\" & compname & "\Root\CIMV2")
'некоторые WMI-классы поддерживаются не во всех версиях Windows
Dim build
build = BuildVersion()
'файл отчета по компьютерам
Set tf = fso.CreateTextFile(DATA_DIRPC & compname & "_pc" & DATA_EXT, True)
'первая строка - заголовки
If HEAD_LINE Then tf.WriteLine "Дата проверки;IP-адрес;Сетевое имя;Домен;Текущий пользователь;Наименование ОС;Дата установки 

ОС;Производитель МП;Наименование МП;Модель CPU;CPU (МГц);Сокет CPU;ОЗУ(Гб);HDD модель;HDD Размер(Гб);CD-

привод;Видеоконтроллер;Сетевой адаптер;Звуковое устройство;Монитор №1;Монитор №2;Монитор №3;Монитор №4"
'дата проверки
tf.Write Date & ";"
 'IP
tf.Write ipLocal & ";"
On error resume next
set oshell=createobject("WScript.shell")
   LogPC "Win32_ComputerSystem", _
		"Name,Domain,UserName", "", _
		"Компьютер", _
		"Сетевое имя,Домен,Текущий пользователь"
LogPC "Win32_OperatingSystem", _
		"Caption,InstallDate", "", _
		"Операционная система", _
		"Наименование,Дата установки"
LogPC "Win32_BaseBoard", _
		"Manufacturer,Product", "", _
		"Материнская плата", _
		"Производитель,Наименование"
'не определяется Core 2 в XP SP2, см. http://support.microsoft.com/kb/953955
LogPC "Win32_Processor", _
		"Name,CurrentClockSpeed,SocketDesignation", "", _
		"Процессор", _
		"Наименование,Частота (МГц),Сокет"
LogPC "Win32_ComputerSystem", _
		"TotalPhysicalMemory", "", _
		"Модули памяти", _
		"Общий объем (Гб)"
'пропускаются USB-диски
LogPC "Win32_DiskDrive", _
		"Model,Size", "InterfaceType <> 'USB'", _
		"Диск", _
		"Наименование,Размер (Гб)"
LogPC "Win32_CDROMDrive", _
		"Name", "", _
		"CD-привод", _
		"Наименование"
'только для XP/2003 и выше
'пропускаются лишние видео-драйверы, собираем реальные видеоадаптеры
If build >= 2600 Then
	LogPC "Win32_VideoController", _
	"Name", "NOT (Name LIKE '%Secondary' OR Name LIKE '%radmin%'  OR Name LIKE '%hook%')", _
	"Видеоконтроллер", _
	"Наименование"
	Else 'для Windows 2000
	LogPC "Win32_VideoController", _
	"Name,AdapterRAM,VideoProcessor,VideoModeDescription,DriverDate,DriverVersion", "", _
	"Видеоконтроллер", _
	"Наименование,Объем памяти (Мб),Видеопроцессор,Режим работы,Дата драйвера,Версия драйвера"
	End If
	'пропускаются отключенные сетевые адаптеры, в том числе минипорты
	'пропускаются виртуальные адаптеры VMware
	If build >= 2600 Then
	LogPC "Win32_NetworkAdapter", _
	"Name", "NetConnectionStatus > 0 AND NOT (Name LIKE 'VMware%')", _
	"Сетевой адаптер", _
	"Наименование"
	End If
	LogPC "Win32_SoundDevice", _
	"Name", "NOT (Name LIKE '%micropho%' OR  Name LIKE '%для дисплеев%' OR  Name LIKE '%Virtual%')", _
	"Звуковое устройство", _
	"Наименование"
' собираем мониторы 
Set objWMIService = GetObject("winmgmts:\\.\root\WMI")
Set colItems = objWMIService.ExecQuery("Select * From WmiMonitorID") 
n=0
For Each objItem in colItems
n=n+1
tf.Write objItem.InstanceName &";"
Next
'закрыть файл 
tf.WriteLine 
tf.Close
End Sub
Sub LogPC(from, sel, where, sect, param)
	Const RETURN_IMMEDIATELY = 16
	Const FORWARD_ONLY = 32
	Dim query, cls, item, prop
	query = "Select " & sel & " From " & from
	If Len(where) > 0 Then query = query & " Where " & where
	Set cls = wmio.ExecQuery(query,, RETURN_IMMEDIATELY + FORWARD_ONLY)
	Dim props, names, num, value
	props = Split(sel, ",")
	names = Split(param, ",")
	num = 1 'номер экземпляра
	For Each item In cls
		For i = 0 To UBound(props)
		'взять значение
		Set prop = item.Properties_(props(i))
		value = prop.Value
		'без проверки на Null возможнен вылет с ошибкой
		If IsNull(value) Then
			value = "-"
		'если тип данных - массив, собрать в строку
		ElseIf IsArray(value) Then
			value = Join(value,",")
		'если указана кратная единица измерения, перевести значение
		ElseIf Right(names(i), 4) = "(Мб)" Then
			value = CStr(Round(value / 1024 ^ 2))
		ElseIf Right(names(i), 4) = "(Гб)" Then
			value = CStr(Round(value / 1024 ^ 3))
		'если тип данных - дата, преобразовать в читаемый вид
		ElseIf prop.CIMType = 101 Then
			value = ReadableDate(value)
		End If
		'вывести в файл непустое значение, заменить спецсимвол ";"
		value = Trim(Replace(value, ";", "_"))
		If Len(value) > 0 Then tf.Write value & ";"
		Next 'i
		'перейти к следующему экземпляру
		num = num + 1
	Next 'item
End Sub
'========= конец раздела инвентаризация компов =================
' ФУНКЦИИ ОБРАБОТКИ ДАННЫХ
'преобразование даты формата DMTF в читаемый вид (ДД.ММ.ГГГГ)
Function ReadableDate(str)
	ReadableDate = Mid(str, 7, 2) & "." & Mid(str, 5, 2) & "." & Left(str, 4)
End Function
'ПРОВЕРИТЬ версию (билд) WMI-сервера
'не все версии совместимы, поэтому скрипт должен знать выполняться или нет
Function BuildVersion()
	Dim cls, item
	Set cls = wmio.ExecQuery("Select BuildVersion From Win32_WMISetting")
	For Each item In cls
		BuildVersion = CInt(Left(item.BuildVersion, 4))
	Next
End Function

Комментарии

1 комментарий к записи “VBS. Инвентаризация железа.”
  1. user1:

    то что нужно

Оставить комментарий к user1