Страницы: 1
RSS
Сбор сведений из реестра Win в домене, Сбор сведений из ветки реестра для заданного диапазона IP
 
Всем доброго дня!
Прошу разобраться с макросом. Что-то видимо заработался...В примере есть таблица с указанными IP в определенном диапазоне. Хотелось бы брать каждый IP из сети, сканировать определенную ветку его (ПК) реестра и заносить соответственно в текущую строку в определенные столбцы значения реестра. Уж простите, давно в VB не сидел. Далее по циклу - берется следующая строка...и так до первой попавшейся пустой строки в конце диапазона. Помогите пожалуйста с циклом - совсем запутался.
Изменено: Mike - 21.02.2024 11:38:23
 
Mike,  
Разбиратся с циклами некогда, но
1. Перед обращение WMI нужно убедится через ICMP малого размера что хост в сети, в противном случае подключение длится долго а результат ошибка
2. А нужно ли в реестр ходить если можно через WMI получить информацию по ПО отфильтровав. Хоть последнее и не быстрее а может и медленнее, но однозначно точнее.
По вопросам из тем форума, личку не читаю.
 
С сеткой все норм...как единичное обращение макрос справляется.
 
Цитата
Mike написал:
С сеткой все норм...как единичное обращение макрос справляется.
я не просетку, а про то что ПК может быть выключен, и на этапе подключения будет пауза пока не произойдет отлуп по ошибке.
По вопросам из тем форума, личку не читаю.
 
В этом отшении берутся IP тех компов, которые в сети со сторонней программы. Кстати, видел где-то средствами VB можно реализовать опрос ПК в диапазоне IP на предмет "онлайн" через определенный промежуток времени, возможно, в дальнейшем найду и реализую эту процедуру, но пока хочется реализовать эту малую часть задумки.
 
Глянул. Допустим, если сократить расположение до "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\" то в массив arrSubKeys попадает одно значение "secure", что видимо говорит об защите данного раздела, хотя в разрешениях вроде етсть все права для администраторов, Эксель запускал от админа.
 
на самом деле ветка реестра лезет в раздел установленных программ и ищет там версию (если есть така прога) , дату установки и (возможно) серийник...и соответственно напротив каждого IP заносит эти сведения в таблицу...повторюсь, "в нахалку" по единичному IP макрос работает, т.е....лезет, выдергивает, записывает в явно указанные ячейки
 
Цитата
Mike написал:
по единичному IP макрос работает, т.е....лезет
Ну у меня не читает этот раздел, но если что, должно быть типо так
Код
Sub zapolnenie()
    Dim intKeys, i As Integer
    Dim rowRange As Range
    Dim LastRow As Long
    Dim strKeyPath, strComputer, arrSubKeys()
    
    ' Скрипт по сбору информации об установленном ПО
    ' информация берется например из ветки реестра
    ' SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18
    ' далее (по идее) должно записывться в этот же файл экселя - для каждого IP - свои данные
    Const HKEY_LOCAL_MACHINE& = &H80000002
    Const ForWriting = 2
    Const ForAppending = 8
    
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    Set rowRange = Range("A3:A" & LastRow)
    strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Products"  ' ветка реестра сокращена
   
    For Each cell In rowRange
        strComputer = cell.Value     ' по идее должно браться значение IP из первой строки диапазона строк и далее по циклу Next rrow (? наверно ?)
'        strComputer = "." 'strComputer = "172.16.100.101"
        ' указываем что oReg будет лезть в реестр
        Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
        ' Указываем куда именно в реестре мы полезем
        oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
        ' Перебор неких subkey в массиве arrSubKeys, на самом деле шаримся по подразделам Installer
        
        strValueName = "ProductID"
        For Each subkey In arrSubKeys
            strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\" & subkey ' ветка реестра сокращена
            'Ищем в подразделах строковой параметр "DisplayName"
            oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue
            If strValue <> Empty Then
                cell.Offset(, 4).Value = strValue
            Else
                i = 1
            End If
        Next
        
        strValueName = "DisplayVersion"
        For Each subkey In arrSubKeys
            strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\" & subkey ' ветка реестра сокращена
            'Ищем в подразделах строковой параметр "DisplayName"
            oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue
            If strValue <> Empty Then
                cell.Offset(, 2).Value = strValue
            Else
                i = 1
            End If
        Next
        
        strValueName = "InstallDate"
        For Each subkey In arrSubKeys
            strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\" & subkey ' ветка реестра сокращена
            'Ищем в подразделах строковой параметр "DisplayName"
             oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue
            If strValue <> Empty Then
                cell.Offset(, 3).Value = strValue
            Else
                i = 1
            End If
        Next
    Next cell
End Sub
 
Мой совет
Делайте функцию, которая по заданному ip опрашивает и возвращает то что нужно. можно массивом.
дополнительно всеж рекомендую Ping у Игоря полно  вариантов
а вот в основной программе цикл по вашим ячейкам , вызов функций и занесения результата. однако все равно рекомендую WMI
Select * from Win32_Product
Where - можно для фильтра использовать
По вопросам из тем форума, личку не читаю.
 
Пишет, что subkey - пустой, может его надо было раньше объявить?
Изменено: Mike - 21.02.2024 15:05:38
 
Цитата
написал:
Делайте функцию, которая по заданному ip опрашивает и возвращает то что нужно. можно массивом.дополнительно всеж рекомендую  Ping у Игоря полно  вариантов
Да! здорово! я ж помню, что был такой вариант опроса IP...Спасибо, обязательно дополнением вставлю.
 
Цитата
Mike написал:
Пишет, что subkey - пустой
уберите "Option Explicit"
 
Цитата
написал:
уберите "Option Explicit"
Так он нигде не прописан...явно в коде не указан, а в опциях самого VB галочка убрана
 
Вроде разобрался. Выкладываю код, может кому пригодится:
Код
Sub regUpload ()
Dim intKeys, i As Integer, strKeys As Variant
Dim rowRange As Range
Dim LastRow As Long
Dim LastCol As Long
' Скрипт по сбору информации об установленном ПО
' информация берется из ветки реестра
' HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall
' данные записываются в соответствующие ячейки
 Const HKEY_LOCAL_MACHINE = &H80000002
LastRow = Cells(rows.Count, "A").End(xlUp).Row
Set rowRange = Range("A3:A" & LastRow) ‘чтение списка IP начинается с A3
LastCol = Cells(LastRow, 5).Column ‘для определения диапазона таблицы указываем ячейку нижней правой области, т.е. «последняя определенная строка + последний столбец
Set colRange = Range(Cells(1, 1), Cells(LastRow, 1)) 
 For Each cell In rowRange ‘ здесь начинается основной цикл
strComputer = cell.Value ‘переменной присваивается значение ячейки из списка
Const ForWriting = 2
Const ForAppending = 8
Set objWsNet = CreateObject("WScript.Network")
Computer = objWsNet.ComputerName
User = objWsNet.UserName
 ' указываем что oReg будет лезть в реестр
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
 ' Указываем куда именно в реестре мы полезем
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall" ‘ в данном примере ветка реестра сокращена – нужно вставить свою, которая интересует
oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
' Перебор неких subkey в массиве arrSubKeys,
' на самом деле шаримся по подразделам Uninstall`а
For Each SubKey In arrSubKeys
         strKeyPath = " SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\" & SubKey ‘ в конце слэш очень важен
        'Ищем в подразделах строковой параметр " ProductID " – выбран в качестве примера, вместо него можно вставить свой интересующий параметр в данной ветке реестра
        strValueName = "" ‘очищаем переменную
        strValueName = "ProductID"
        oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE, strKeyPath, _
        strValueName, strValue
        If strValue <> Empty Then
        cell.Offset(, 4).Value = strValue ‘записываем в 4 столбец текущей строки
        Else
        i = 1
        End If
Next
 For Each SubKey In arrSubKeys
 ‘ далее еще два аналогичных цикла для двух других параметров текущей ветки реестра
        strKeyPath = " SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\" & SubKey
        'Ищем в подразделах строковой параметр " DisplayVersion "
        strValueName = ""
        strValueName = "DisplayVersion"
         oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE, strKeyPath, _
        strValueName, strValue
        If strValue <> Empty Then
        cell.Offset(, 3).Value = strValue
        Else
        i = 1
        End If
Next
 For Each SubKey In arrSubKeys
        strKeyPath = " SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\" & SubKey
        'Ищем в подразделах строковой параметр " InstallDate "
        strValueName = ""
         strValueName = "InstallDate"
         oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE, strKeyPath, _
        strValueName, strValue
        If strValue <> Empty Then
        cell.Offset(, 2).Value = strValue
        Else
        i = 1
        End If
Next
 Next cell ‘ закрываем основной цикл
 
End Sub

Единственное, хочу все-таки "допилить" код на проверку ПК в онлайне, т.к. если ПК не в сети (не пингуется), то вылетает ошибка
 
Код
        strValueName = "" ‘очищаем переменную
        strValueName = "ProductID" -
смысл перевого присвоения отсутсвует.

Зачем три цикла  можно примерно так
Код
Arr_strValueName = Array("ProductID","DisplayVersion","InstallDate")
For Each SubKey In arrSubKeys
         strKeyPath = " SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\" & SubKey ‘ в конце слэш очень важен
        'Ищем в подразделах строковой параметр " ProductID " – выбран в качестве примера, вместо него можно вставить свой интересующий параметр в данной ветке реестра
 '       strValueName = "" ‘очищаем переменную
'        strValueName = "ProductID"
J=5
For each strValueName in Arr_strValueName 
J=J-1
        oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE, strKeyPath, _
        strValueName, strValue
        If strValue <> Empty Then
        cell.Offset(, J).Value = strValue ‘записываем в J столбец текущей строки
        Else
        i = 1  ' не понял зачем

        End If
Next

Next



Цитата
Mike написал:
т.к. если ПК не в сети (не пингуется), то вылетает ошибка
-
Цитата
БМВ написал:
1. Перед обращение WMI нужно убедится через ICMP малого размера что хост в сети, в противном случае подключение длится долго а результат ошибка
:D
По вопросам из тем форума, личку не читаю.
 
Пытался внести проверку...если НЕ пингуется, то идти к следующему значению ( с соответствующей пометкой "0" или" "1" в ячейке 6 столбца), но, что то пошло не так...
Код
Sub regcrypto()
Dim intKeys, i As Integer, strKeys As Variant
Dim rowRange As Range
Dim LastRow As Long
Dim LastCol As Long
' Скрипт по сбору информации об установленном ПО
 
Const HKEY_LOCAL_MACHINE = &H80000002
LastRow = Cells(rows.Count, "A").End(xlUp).Row
Set rowRange = Range("A3:A" & LastRow)
LastCol = Cells(LastRow, 8).Column
Set colRange = Range(Cells(1, 1), Cells(LastRow, 7))
Arr_strValueName = Array("ProductID", "DisplayVersion", "InstallDate")

For Each cell In rowRange 'начало основного цикла

If Not Ping(strComputer) Then
cell.Offset(, 6).Value = 0
Else:
strComputer = cell.Value
Const ForWriting = 2
Const ForAppending = 8
Set objWsNet = CreateObject("WScript.Network")
Computer = objWsNet.ComputerName
User = objWsNet.UserName
cell.Offset(, 5).Value = 1

' указываем что oReg будет лезть в реестр
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
 
' Указываем куда именно в реестре мы полезем
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer" ' реальная ветка убрана для примера
oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
' Перебор неких subkey в массиве arrSubKeys,

For Each SubKey In arrSubKeys
        strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\" & SubKey ' реальная ветка убрана для примера
j = 5
For Each strValueName In Arr_strValueName
j = j - 1
        oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE, strKeyPath, _
        strValueName, strValue
        If strValue <> Empty Then
        cell.Offset(, j).Value = strValue
        Else
        End If
Next
'End If

Next cell

End Sub
 
strComputer = cell.Value нужно перед Ping

а вот
' Указываем куда именно в реестре мы полезем
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer" ' реальная ветка убрана для примера
можно до цикла, оно не меняется, ди в целом такое лучше не переменной а константой указывать.


Код
Const ForWriting = 2
Const ForAppending = 8
Set objWsNet = CreateObject("WScript.Network")
Computer = objWsNet.ComputerName
User = objWsNet.UserName


оно не используется вааще.
Изменено: БМВ - 22.02.2024 19:18:58
По вопросам из тем форума, личку не читаю.
 
Спасибо всем! Разобрался немного.
Уж да простят меня модераторы, но не знаю создать новую ветку форума или эту добить... Вопрос в этом же направлении и с тем же принципом, т.е. IP берутся с одного столбца, значения параметра для, теперь уже, записи в реестр - с соседнего. Перепробовал много всякого (в самом коде есть комменты), но где то слышал, что для HKLM это не прокатывает, подскажите где подсмотреть пожалуйста.  
 
Цитата
Mike написал:
Уж да простят меня модераторы, но не знаю создать новую ветку форума или эту добить
А сами как думаете?
Цитата
Mike написал:
Сбор сведений из реестра Win в домене,
Цитата
Mike написал:
для, теперь уже, записи в реестр - с соседнего.
По вопросам из тем форума, личку не читаю.
 
Ок. Принято. Спасибо всем за помощь!
Страницы: 1
Наверх