Option Explicit

 

 

   Private Const REG_SZ As Long = 1

   Private Const REG_DWORD As Long = 4

 

   Private Const HKEY_CLASSES_ROOT = &H80000000

   Private Const HKEY_CURRENT_USER = &H80000001

   Private Const HKEY_LOCAL_MACHINE = &H80000002

   Private Const HKEY_USERS = &H80000003

 

   Private Const ERROR_NONE = 0

   Private Const ERROR_BADDB = 1

   Private Const ERROR_BADKEY = 2

   Private Const ERROR_CANTOPEN = 3

   Private Const ERROR_CANTREAD = 4

   Private Const ERROR_CANTWRITE = 5

   Private Const ERROR_OUTOFMEMORY = 6

   Private Const ERROR_ARENA_TRASHED = 7

   Private Const ERROR_ACCESS_DENIED = 8

   Private Const ERROR_INVALID_PARAMETERS = 87

   Private Const ERROR_NO_MORE_ITEMS = 259

 

   Private Const KEY_QUERY_VALUE = &H1

   Private Const KEY_SET_VALUE = &H2

   Private Const KEY_ALL_ACCESS = &H3F

 

    Private Const REG_OPTION_NON_VOLATILE = 0

    Private Const SE_PRIVILEGE_ENABLED    As Long = 2&

    Private Const TOKEN_ADJUST_PRIVILEGES As Long = &H20

    Private Const TOKEN_QUERY             As Long = 8&

    Private Const ERROR_NO_TOKEN         As Long = 1008&

 

 

 

 

Private Type TOKEN_PRIVILEGES

    PrivilegeCount  As Long

    LuidLowPart     As Long

    LuidHighPart    As Long

    Attributes      As Long

End Type

 

 

 

Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueW" (ByVal lpSystemName As Long, ByVal lpName As Long, lpLuid As Long) As Long

Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long

Private Declare Function OpenThreadToken Lib "advapi32.dll" (ByVal ThreadHandle As Long, ByVal DesiredAccess As Long, ByVal OpenAsSelf As Long, TokenHandle As Long) As Long

Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, ByVal PreviousState As Long, ByVal ReturnLength As Long) As Long

Private Declare Function GetCurrentThread Lib "kernel32.dll" () As Long

Private Declare Function GetCurrentProcess Lib "kernel32.dll" () As Long

Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long

 

 

 

 

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long

Private Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long

Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long

Private Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long

Private Declare Function RegSetValueExString 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

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

 

   Private Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long

      

       Dim lValue As Long

       Dim sValue As String

  

  

   Select Case lType

          

           Case REG_SZ

              

               sValue = vValue & Chr$(0)

               SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))

          

           Case REG_DWORD

          

               lValue = vValue

               SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)

          

           End Select

          

          

   End Function

 

 

 

Private Function SetCurrentProcessPrivileges(PrivilegeName As String) As Boolean

    

    Dim tp As TOKEN_PRIVILEGES, hToken&

    

    If LookupPrivilegeValue(0&, StrPtr(PrivilegeName), tp.LuidLowPart) Then   'i.e. "SeDebugPrivilege"

    

        If 0 = OpenThreadToken(GetCurrentThread(), TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, 1&, hToken) Then

        

            If Err.LastDllError = ERROR_NO_TOKEN Then

            

                If 0 = OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hToken) Then

                    Exit Function

                End If

            Else

                Exit Function

            End If

        End If

 

        tp.PrivilegeCount = 1

        tp.Attributes = SE_PRIVILEGE_ENABLED

        SetCurrentProcessPrivileges = AdjustTokenPrivileges(hToken, 0&, tp, 0&, 0&, 0&)

        CloseHandle hToken

    End If

End Function

 

 

 

 

 

Private 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_SET_VALUE, hKey)

    lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)

    RegCloseKey (hKey)

    

End Sub

 

 

 

Private Sub Form_Load()

 

    SetCurrentProcessPrivileges "SeBackupPrivilege"

    SetCurrentProcessPrivileges "SeRestorePrivilege"

    SetCurrentProcessPrivileges "SeTakeOwnershipPrivilege"

    SetCurrentProcessPrivileges "SeSecurityPrivilege"       'SACL

 

 

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

 

 

End Sub