Изменение ключа в HKEY_LOCAL_MACHINE

[salieri]

Здравствуйте!
Обратил внимание, что когда меняешь ключ в HKEY_CURRENT_USER, то всё работает.
Стоит перейти в HKEY_LOCAL_MACHINE, ничего не происходит.
Почитал в интернете, нашёл кое-какие примеры открытия доступа к HKEY_LOCAL_MACHINE, но ничего не помогло.
Прикрепляю исходник.
Уже и от имени администратора запускал - толку 0.

[Хакер]

Под какой ОС-то проблема наблюдается? А то сейчас запущу под Windows 98, там с лёту всё поменяется.

[The trick]

Ну скорее всего дело в WoW64 redirection или виртуализации реестра. Попробуй для начала указать ключ KEY_WOW64_64KEY. Для обхода виртуализации нужно добавить специальный манифест.

[salieri]

Под какой ОС-то проблема наблюдается? А то сейчас запущу под Windows 98, там с лёту всё поменяется.

WIN 10 LTSC 1809 RUS x64

[salieri]

Ну скорее всего дело в WoW64 redirection или виртуализации реестра. Попробуй для начала указать ключ KEY_WOW64_64KEY. Для обхода виртуализации нужно добавить специальный манифест.

попробовал, не помогло

Код: Выделить всё

Public Sub SetKeyValue(sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)
   
    Dim lRetVal As Long      'result of the SetValueEx function
    Dim hKey As Long         'handle of open key

    'open the specified key
    lRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, sKeyName, 0, KEY_WOW64_64KEY, hKey) 'KEY_SET_VALUE
    lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
    RegCloseKey (hKey)
   
End Sub

[Teranas]

Посмотри внимательно этот пример.

Код: Выделить всё

Public Function RegKeySetOwnerShip(lHive&, ByVal KeyName$, SidString As String, Optional bUseWow64 As Boolean) As Boolean
    '
    'Parameters:
    '
    'lHive - pseudohandle to root key (hive). This value can be 0.
    'KeyName - Path to registry key. Is lHive is 0, this path must be Full, otherwise it must be relative to hive.
    'SidString - string representation of SID
    'bUseWow64 - (optional) if true, this function use registry redirector, so all calls will be directed to 32-bit keys on 64-bit machine

    On Error GoTo ErrorHandler:
   
    Dim flagDisposition As Long
    Dim bufSid()    As Byte
    Dim hKey        As Long
    Dim lret        As Long
    Dim bIsWOW64    As Boolean
   
    bIsWOW64 = IsWin64()
   
    Call NormalizeKeyNameAndHiveHandle(lHive, KeyName)

    SetCurrentProcessPrivileges "SeBackupPrivilege"
    SetCurrentProcessPrivileges "SeRestorePrivilege"
    SetCurrentProcessPrivileges "SeTakeOwnershipPrivilege"
   
    ' SeTakeOwnershipPrivilege + WRITE_OWNER
    If ERROR_SUCCESS <> RegOpenKeyEx(lHive, StrPtr(KeyName), 0&, WRITE_OWNER Or (bIsWOW64 And KEY_WOW64_64KEY And Not bUseWow64), hKey) Then
        'Key doesn't exist
        Exit Function
    Else
        RegCloseKey hKey
    End If
   
    bufSid = CreateBufferedSID(SidString)
   
    ' ACCESS_SYSTEM_SECURITY
    If ERROR_SUCCESS = RegCreateKeyEx(lHive, StrPtr(KeyName), 0&, 0&, REG_OPTION_BACKUP_RESTORE, WRITE_DAC Or (bIsWOW64 And KEY_WOW64_64KEY And Not bUseWow64), ByVal 0&, hKey, flagDisposition) Then
       
'        If flagDisposition = REG_CREATED_NEW_KEY Then
'            RegCloseKey hKey
'            RegDeleteKeyEx lHive, StrPtr(KeyName), KEY_WOW64_64KEY And Not bUseWow64, 0&
'            Debug.Print "Key doesn't exist"
'            Exit Function
'        End If
       
        'IIf(bUseWow64 And isWin64(), SE_REGISTRY_WOW64_32KEY, SE_REGISTRY_KEY)
       
        lret = SetSecurityInfo(hKey, SE_REGISTRY_KEY, OWNER_SECURITY_INFORMATION, VarPtr(bufSid(0)), 0&, 0&, 0&)
       
        If lret = ERROR_SUCCESS Then
           
            RegKeySetOwnerShip = True
            Debug.Print KeyName & " - OwnerShip granted successfully."
       
        Else

            Debug.Print KeyName & " - Error in SetSecurityInfo: " & lret
           
        End If
       
        RegCloseKey hKey
    End If
   
    Exit Function
ErrorHandler:
    Debug.Print "Error in RegSetOwnerShip", Err, Err.Description
End Function


Вот ещё

Код: Выделить всё

Public Function SetKey(ByVal hKey As REG_HKEY, ByVal strPath As String, ByVal strValue As String, ByVal VarData As Variant, ByVal nType As REG_TYPE, Optional ByVal x64 As Boolean = False) As Boolean
    Dim Ret As Long, KEY_WOW  As Long, Result As Long, L As Long
    If x64 Then
        KEY_WOW = KEY_WOW64_64KEY
    Else
        KEY_WOW = KEY_WOW64_32KEY
    End If
    If RegCreateKeyEx(hKey, strPath, 0, nType, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS Or KEY_WOW, ByVal 0&, Ret, Result) = ERROR_SUCCESS Then
        Select Case nType
          Case REG_SZ
            RegSetValueEx Ret, strValue, 0, REG_SZ, ByVal CStr(VarData), Len(CStr(VarData))
          Case REG_DWORD
            RegSetValueEx Ret, strValue, 0, REG_DWORD, CLng(VarData), 4
          Case REG_BINARY
            RegSetValueEx Ret, strValue, 0, REG_BINARY, CByte(VarData), 4
        End Select
    End If
    RegCloseKey Ret
End Function


[The trick]

RegOpenKeyEx

нужно документацию читать прежде чем писать код

[salieri]

Посмотри внимательно этот пример.

Подправил, что смог, остальных функций, которые у вас в коде, не нашёл в интернете.
По-прежнему не работает.

Код: Выделить всё


Public Sub SetKeyValue(sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)
   
    Dim lRetVal As Long      'result of the SetValueEx function
    Dim hKey As Long         'handle of open key

       Dim sValue As String

Dim flagDisposition As Long

 
    Dim bIsWOW64    As Boolean
   
       Dim bufSid()    As Byte
   
   
    bIsWOW64 = True
   
    lRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, sKeyName, 0&, WRITE_OWNER Or (bIsWOW64 And KEY_WOW64_64KEY And KEY_SET_VALUE), hKey)
    If lRetVal <> 0 Then
        Exit Sub
    Else
        RegCloseKey hKey
    End If
   

lRetVal = RegCreateKeyEx(HKEY_LOCAL_MACHINE, StrPtr(sKeyName), 0&, 0&, REG_OPTION_BACKUP_RESTORE, WRITE_DAC Or (bIsWOW64 And KEY_WOW64_64KEY), ByVal 0&, hKey, flagDisposition)

    If lRetVal = 0 Then
       
    sValue = vValueSetting & Chr$(0)
   lRetVal = RegSetValueExString(hKey, sValueName, 0&, REG_SZ, ByVal sValue, Len(sValue))
    RegCloseKey (hKey)
      End If
     
     
     
End Sub

Private Sub Form_Load()

    SetCurrentProcessPrivileges "SeSecurityPrivilege"
    SetCurrentProcessPrivileges "SeBackupPrivilege"
    SetCurrentProcessPrivileges "SeRestorePrivilege"
    SetCurrentProcessPrivileges "SeTakeOwnershipPrivilege"

AddAccessControlElement "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\MMDevices\Audio\Capture\{877608b9-0609-4cf4-b714-3984ab0867c0}", SE_REGISTRY_KEY, "CURRENT_USER", COMMON_FULL_CONTROL, SET_ACCESS

    SetKeyValue "SOFTWARE\Microsoft\Windows\CurrentVersion\MMDevices\Audio\Capture\{877608b9-0609-4cf4-b714-3984ab0867c0}", "xxx", "Vasya1", REG_SZ

End Sub



[salieri]

Друзья, всем огромное спасибо!
Разобрался, наконец!
В такой связке заработало!

Код: Выделить всё

Public Sub SetKeyValue(sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)
   
   
    Dim hKey As Long         'handle of open key

       Dim sValue As String


     RegOpenKeyEx HKEY_LOCAL_MACHINE, sKeyName, 0&, WRITE_OWNER Or KEY_WOW64_64KEY Or KEY_SET_VALUE, hKey
    sValue = vValueSetting & Chr$(0)
   RegSetValueExString hKey, sValueName, 0&, REG_SZ, ByVal sValue, Len(sValue)
    RegCloseKey (hKey)

     
End Sub

[salieri]

Здравствуйте ещё раз!

Код: Выделить всё

Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long

RegOpenKeyEx HKEY_LOCAL_MACHINE, KeyPath, 0, WRITE_OWNER Or KEY_WOW64_64KEY Or KEY_SET_VALUE, hKey
RegSetValueEx hKey, KeyName, 0, REG_DWORD, Chr(KeyVal), 4

С записью типа REG_SZ всё отлично, но при попытке сделать REG_DWORD, получается только через Chr(KeyVal), а когда значение, например, 268435457, то появляется ошибка рантайма.
Я понимаю, что через Chr() - это не делается, но у меня никак не вышло иначе.
Параметр lpValue менял на Long, нужного результата не дало.
В чём причина может быть, подскажите, пожалуйста.

[salieri]

Разобрался!
УРА!
Дело было в декларации функции:

Код: Выделить всё

Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Any, ByVal cbData As Long) As Long


[Teranas]

Так она и идёт везде

Код: Выделить всё

Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long