поиск реестра для значения, если найденное совпадение удалить родительский ключ

Question

Мне нужна помощь со сценарием, который будет проходить через реестр для определенного значения и после совпадения найдено удаление родительского ключа. Я нашел код, но он не работает. Я подозреваю, что не проходит через ключ реестра для соответствия.

Option Explicit 

Const HKEY_LOCAL_MACHINE = &H80000002 
Const cRegKeyStartingPath = "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall" 
Const cRegValueToFind  = "Ossec HIDS" 
Const cRegDataToMatch  = "DisplayName" 

Dim oReg, subkey, arrSubKeys, sCurrentKey, sCurrentValuePath, iDeletedCount 
iDeletedCount = 0 

Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv") 
oReg.EnumKey HKEY_LOCAL_MACHINE, cRegKeyStartingPath, arrSubKeys 

On Error Resume Next 
For Each subkey In arrSubKeys 
    If Err.Number = 0 Then 'in case the collection is empty 
     sCurrentKey = "HKLM\" & cRegKeyStartingPath & subkey 
     sCurrentValuePath = sCurrentKey & "\" & cRegValueToFind 
     If customRegRead(sCurrentValuePath) = cRegDataToMatch Then 
      WScript.Echo "Going to delete "&sCurrentKey 
      DeleteRegKey sCurrentKey&"\" 
      iDeletedCount = iDeletedCount + 1 
     End If 
    Else 
     iDeletedCount = -1 
    End If 
Next 

Select Case iDeletedCount 
    Case 0 
     WScript.Echo "No matching keys found" 
    Case -1 
     WScript.Echo "No subkeys found below HKLM\"&cRegKeyStartingPath 
    Case Else 
     WScript.Echo "Deleted " & iDeletedCount & " keys" 
End Select 

Function customRegRead(sRegValue) 

    Dim oShell 
    Dim sRegReturn 

    Set oShell = CreateObject("WScript.Shell") 

    On Error Resume Next 
    Err.Clear 
    sRegReturn = oShell.RegRead(sRegValue) 
    If Err.Number<>0 Then 
     customRegRead = "Failed To Read Value" 
    Else 
     customRegRead = sRegReturn 
    End If 

End Function 

Sub DeleteRegKey(sKey) 

    Dim oShell 
    Set oShell = CreateObject("Wscript.Shell") 
    oShell.RegDelete sKey 

End Sub 

Если есть что-то более чистое/лучшее, пожалуйста, советую.

Answer 1

Я предлагаю удалить все вхождения On Error Resume Next и придерживаться методов WMI. Также ваш текущий код не использует рекурсию, поэтому вы можете находить значения только в непосредственных подразделах cRegKeyStartingPath. Вам понадобится рекурсия для перемещения дерева произвольной глубины.

EnumValues Используйте для перечисления значения данного ключа:

rc = reg.EnumValues(HKLM, key, names, types) 

Метод возвращает 0 в случае успеха, так что вы можете проверить на наличие ошибок при оценке кода возврата. После завершения вызова переменная names содержит массив с именами значений в key или Null, если ключ не содержит значений (что меньше значения по умолчанию). Таким образом, код для проверки, если существует определенное значение в данном ключе может выглядеть следующим образом:

reg.EnumValues HKLM, key, names, types 
If Not IsNull(names) Then 
    For Each name In names 
    If name = "foo" Then 
     reg.GetStringValue HKLM, key, name, data 
     If data = "bar" Then 
     'delete key here 
     Exit For 
     End If 
    End If 
    Next 
End If 

Вы можете пройти реестр путем перечисления подразделов данного ключа через EnumKey и рекурсию в эти подразделы:

Sub TraverseRegistry(root, key) 
    reg.EnumKey root, key, subkeys 
    If Not IsNull(subkeys) Then 
    For Each sk In subkeys 
     TraverseRegistry root, key & "\" & sk 
    Next 
    End If 
End Sub 

Для удаления ключа используйте метод DeleteKey. Информация, которая должна быть удалена, - это то, что у вас уже есть: это значение переменной key из процедуры перечисления значений, когда значение found истинно. Однако вы не можете удалить ключ, имеющий подразделы, поэтому вы должны сначала удалить тех. Что-то, для которого вы можете повторно использовать процедуру обхода сверху:

Sub DelKey(root, key) 
    reg.EnumKey root, key, subkeys 
    If Not IsNull(subkeys) Then 
    For Each sk In subkeys 
     DelKey root, key & "\" & sk 'delete subkeys first 
    Next 
    End If 
    'at this point all subkeys have already been deleted, so we can 
    'now delete the parent key 
    reg.DeleteKey root, key 
End Sub 

Положите все вместе, и вы получите что-то вроде этого:

Const HKLM = &h80000002 

Const StartKey = "SOFTWARE\Wow...ion\Uninstall" 
Const SearchValue = "DisplayName" 
Const MatchData = "Ossec HIDS" 

Set reg = GetObject("winmgmts://./root/default:StdRegProv") 

FindAndDeleteKey HKLM, StartKey, SearchValue, MatchData 

Sub FindAndDeleteKey(root, key, value, data) 
    reg.EnumValues HKLM, key, names, types 
    If Not IsNull(names) Then 
    For Each name In names 
     If name = value Then 
     reg.GetStringValue HKLM, key, name, regdata 
     If regdata = data Then 
      DelKey root, key 
      Exit Sub 
     End If 
     End If 
    Next 
    End If 

    'value not found in current key => continue search in subkeys 
    reg.EnumKey root, key, subkeys 
    If Not IsNull(subkeys) Then 
    For Each sk In subkeys 
     FindAndDeleteKey root, key & "\" & sk, value, data 
    Next 
    End If 
End Sub 

Sub DelKey(root, key) 
    reg.EnumKey root, key, subkeys 
    If Not IsNull(subkeys) Then 
    For Each sk In subkeys 
     DelKey root, key & "\" & sk 'delete subkeys first 
    Next 
    End If 
    'at this point all subkeys have already been deleted, so we can 
    'now delete the parent key 
    reg.DeleteKey root, key 
End Sub 

Поскольку вы ищете конкретное значение с конкретными данными вы могли бы даже упростить FindAndDeleteKey() к этому:

Sub FindAndDeleteKey(key) 
    'Try to read the value directly. If the value doesn't exist this will 
    'simply return a non-zero return code and set data to Null. 
    reg.GetStringValue HKLM, key, SearchValue, data 
    If Not IsNull(data) Then 
    'value does exist 
    If data = MatchData Then 
     DelKey HKLM, key 
     Exit Sub 
    End If 
    End If 

    'value not found in current key => continue search in subkeys 
    reg.EnumKey HKLM, key, subkeys 
    If Not IsNull(subkeys) Then 
    For Each sk In subkeys 
     FindAndDeleteKey key & "\" & sk 
    Next 
    End If 
End Sub 

---

Редактировать: Ниже приведена версия, которая генерирует отладочный вывод. Запустите его в командной строке через cscript debug_sample.vbs. Обратите внимание, что поскольку вы хотите удалить материал в HKLM, вы должны должен запустить сценарий «как администратор», когда UAC включен.

Const HKLM = &h80000002 

Const StartKey = "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall" 
Const SearchValue = "DisplayName" 
Const MatchData = "Ossec HIDS" 

Set reg = GetObject("winmgmts://./root/default:StdRegProv") 

FindAndDeleteKey StartKey 

Sub FindAndDeleteKey(key) 
    WScript.Echo "[HKLM\" & key & "]" 
    rc = reg.GetStringValue(HKLM, key, SearchValue, data) 
    If Not IsNull(data) Then 
    WScript.Echo """" & SearchValue & """=""" & data & """" 
    If data = MatchData Then 
     DelKey HKLM, key 
     Exit Sub 
    End If 
    Else 
    WScript.Echo "'" & SearchValue & "' not found in [HKLM\" & key & "], rc=" & rc 
    End If 

    reg.EnumKey HKLM, key, subkeys 
    If Not IsNull(subkeys) Then 
    For Each sk In subkeys 
     FindAndDeleteKey key & "\" & sk 
    Next 
    End If 
End Sub 

Sub DelKey(root, key) 
    reg.EnumKey root, key, subkeys 
    If Not IsNull(subkeys) Then 
    For Each sk In subkeys 
     DelKey root, key & "\" & sk 
    Next 
    End If 
    rc = reg.DeleteKey(root, key) 
    WScript.Echo "Deleting [HKLM\" & key & "], rc=" & rc 
End Sub 

я смог воспроизвести код возврата 6 (Недопустимый дескриптор) с недействительным значением hDefKey, например, &h8000002 (всего 7 цифр) или h80000002 (отсутствует амперсанд).