Rename Registry Key

Leserbewertung(5):bewerten...
kommentieren...

Klaus Prinz Software Consulting


Die Registry war für mich eigentlich Geschichte, denn ich dachte, im Rahmen meines Win32-API-Buches alles gelöst zu haben, was der Mensch im Umgang mit der Registry so braucht. Bis heute. Dann musste ich eine kompletten Zweig in der Registry umbenennen und machte mich auf die Suche nach einer Win32-Funktion namens RegRenameKey oder RegRenameKeyEx. Mit Verwunderung stellte ich fest, dass diese Funktionen meiner Fantasie entsprungen sind, aber offensichtlich nicht der von Microsoft.

Nach über fünf Stunden war das Problem endlich gelöst und mein Registry-Wrapper enthielt die neue Methode renameKey.

Eine Möglichkeit wäre natürlich, den neuen Key zu erzeugen und die Strukturen des alten Keys rekursiv (RegEnumKeyEx und RegEnumValue) unter den neuen Key zu duplizieren (RegCreateKeyEx und RegSetValueEx). Die hier gezeigte Lösung scheint mir eleganter zu sein. Der alte Zweig wird als Datei gesichert (RegSaveKey) und unter den neu angelegten Key angelegt (RegRestoreKey).

Dazu sind gleich mehrere Hürden zu nehmen, doch die größte Überraschung war das Thema Prozessrechte, denn die Anwendung benötigt Backup- und Restore-Privilegien im Dateisystem, wozu die Registry ja bekanntlich gehört. Die Rechte werden in setBackupAndRestorePriviliges hergestellt und in resetBackupAndRestorePriviliges wieder zurückgenommen. Die dritte Hilfsroutine getErrorMessage ermittelt die Fehlertext zu den Rückgabewerten der Funktionen und ist eigentlich nur Beiwerk.

Durch das Auslagern des Themas Privilegien wurde die eigentliche Methode renameKey recht kompakt. Übrigens, eine LUID ist ein lokal (!) eindeutiger 64-Bit-Wert.

Achtung: RegRestoreKey existiert nur unter WinNT (NT 4, 2000, XP etc.). Man muss also vor Aufruf der renameKey-Methode die Windows-Version abfragen (über GetVersionEx) und den Aufruf damit sichern. Für Win95, 98 und Me scheint die Funktion RegReplaceKey geeignet zu sein, doch die solchermaßen verursachten Registry-Änderungen werden laut MSDN erst nach einem Neustart wirksam.

Mein Kunde ist mit dem Ausschluss von Nicht-NT-Systemen zufrieden, womit ich also nicht weiß, ob es über RegReplaceKey läuft. Sollte es jemand probiert haben, so bitte ich um Feedback.

Deklarationen 

'Error-Konstanten
    Private Const ERROR_SUCCESS = 0
    Private Const ERROR_FILE_NOT_FOUND = 2
    Private Const ERROR_ACCESS_DENIED = 5

'FormatMessage-Quellen
    Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000

'Rechte
    Private Type LUID
        LowPart As Long
        HighPart As Long
    End Type

    Private Type LUID_AND_ATTRIBUTES
        pLuid As LUID
        Attributes As Long
    End Type

 

    Private Type TOKEN_PRIVILEGES
        PrivilegeCount As Long
        Privileges(1) As LUID_AND_ATTRIBUTES
    End Type
'HKEY-Konstanten
    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 HKEY_CURRENT_CONFIG = &H80000005
    Private Const HKEY_DYN_DATA = &H80000006

    Public Enum enumHKEY
        enumHKEY_CLASSES_ROOT = HKEY_CLASSES_ROOT
        enumHKEY_CURRENT_USER = HKEY_CURRENT_USER
        enumHKEY_LOCAL_MACHINE = HKEY_LOCAL_MACHINE
        enumHKEY_USERS = HKEY_USERS
        enumHKEY_CURRENT_CONFIG = HKEY_CURRENT_CONFIG
        enumHKEY_DYN_DATA = HKEY_DYN_DATA
    End Enum

'KEY_READ-Komponenten
    Private Const STANDARD_RIGHTS_ALL = &H1F0000
    Private Const STANDARD_RIGHTS_READ = &H20000
    Private Const KEY_QUERY_VALUE = 1
    Private Const KEY_ENUMERATE_SUB_KEYS = 8
    Private Const KEY_NOTIFY = &H10&
    Private Const SYNCHRONIZE = &H100000
    Private Const KEY_CREATE_LINK = &H20
    Private Const KEY_CREATE_SUB_KEY = 4
    Private Const KEY_SET_VALUE = 2
    Private Const KEY_READ = (STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE)
    Private Const KEY_WRITE = ((STANDARD_RIGHTS_ALL Or KEY_SET_VALUE) And (Not SYNCHRONIZE))
    Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
'Rename und Rechte
    Private Const REG_FORCE_RESTORE = &H8
    Private Const TOKEN_ADJUST_PRIVLEGES = &H20
    Private Const TOKEN_QUERY = &H8
    Private Const SE_PRIVILEGE_ENABLED = &H2
    Private Const SE_RESTORE_NAME = "SeRestorePrivilege"
    Private Const SE_BACKUP_NAME = "SeBackupPrivilege"
'Funktionen
    Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey 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, ByRef phkResult 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, ByVal lpdwDisposition As Long) As Long
    Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, ByVal lpSource As Long, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, nSize As Long, Arguments As Long) As Long

'Renaming
    Private Declare Function RegRestoreKey Lib "advapi32.dll" Alias "RegRestoreKeyA" (ByVal hKey As Long, ByVal lpFile As String, ByVal dwFlags As Long) As Long
    Private Declare Function RegSaveKey Lib "advapi32.dll" Alias "RegSaveKeyA" (ByVal hKey As Long, ByVal lpFile As String, ByVal lpSecurityAttributes As Long) As Long

'Prozessrechte
    Private Declare Function GetCurrentProcess Lib "kernel32" () 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 LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) 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

 
Variablen

 

    Private m_hToken As Long		'Prozess-Token
    Private m_TP As TOKEN_PRIVILEGES	'Prozessprivilegien-Struktur
    Private m_RestoreLuid As LUID	'Restore-Privileg
    Private m_BackupLuid As LUID	'Backup-Privileg
    Private Const SITUATION_BASE As Long = 13800 'klassenspezifische Fehlerbasis

Methode renameKey

Public Sub renameKey(ByVal nHKEY As enumHKEY, ByVal sKeySource As String, ByVal sKeyDestination As String)
    '====================================================================================
    'Date:      2004-01-20
    'Function:  übergebenen Schlüssel umbenennen
    '------------------------------------------------------------------------------------
    'Argumente:
    '   nHKEY               KEY
    '   sKeySource          alter Schlüsselname
    '   sKeyDestination     neuer Schlüsselname
    '====================================================================================
    Dim hKeySource As Long          'Key-Handle der Quellstruktur
    Dim hKeyDestination As Long     'Key-Handle der Zielstruktur
    Dim nResult As Long             'Rückgabe der Funktionen
    Dim sFile As String             'Name der Reg-Datei
    Dim nNull As Long
    On Error GoTo ErrHandler
    'erforderliche Rechte einstellen
    setBackupAndRestorePriviliges
    sFile = "C:\RegTemp.txt"
    'Quellschlüssel öffnen
    nResult = RegOpenKeyEx(nHKEY, sKeySource, 0&, KEY_ALL_ACCESS, hKeySource)
    If nResult = ERROR_SUCCESS Then
        'Datei entfernen
        If Len(Dir(sFile)) > 0 Then
            Kill sFile
        End If
        'Quellschlüssel speichern
        nResult = RegSaveKey(hKeySource, sFile, 0&)
        If nResult = ERROR_SUCCESS Then
            'Versuch, Zielschlüssel zu öffnen ...
            nResult = RegOpenKeyEx(nHKEY, sKeyDestination, 0&, KEY_ALL_ACCESS, hKeyDestination)
            If nResult = ERROR_FILE_NOT_FOUND Then
                'Zielschlüssel erzeugen ...
                nResult = RegCreateKeyEx(nHKEY, sKeyDestination, 0&, vbNullString, 0&, KEY_ALL_ACCESS, 0&, hKeyDestination, 0&)
                If nResult <> ERROR_SUCCESS Then
                    Err.Raise nResult, , getErrorMessage(nResult)
                End If
            End If
            '... und gespeicherte Strukturen erzeugen
            nResult = RegRestoreKey(hKeyDestination, sFile, REG_FORCE_RESTORE)
            If nResult <> ERROR_SUCCESS Then
                Err.Raise nResult, , getErrorMessage(nResult)
            End If
            'Zielschlüssel schließen
            RegCloseKey hKeyDestination
        Else
            Err.Raise nResult, , getErrorMessage(nResult)
        End If
        'Quellschlüssel schließen
        RegCloseKey hKeySource
        'Datei entfernen
        If Len(Dir(sFile)) > 0 Then
            Kill sFile
        End If
    End If
    'Rechte wieder zurücknehmen
    resetBackupAndRestorePriviliges
    Exit Sub
    
ErrHandler:
    RegCloseKey hKeySource
    RegCloseKey hKeyDestination
    If InStr(1, Err.Source, ":") = 0 Then Err.Source = "CCSysRegistry:renameKey"
    Err.Raise Err.Number
End Sub

Rechte einstellen

Private Sub setBackupAndRestorePriviliges()
    '====================================================================================
    'Date:      2004-01-20
    'Function:  Backup- und Restore-Privilegien einrichten
    '====================================================================================
    Dim nResult As Long             'Rückgabe der Funktionen
    On Error GoTo ErrHandler
    'Prozess-Token öffnen
    nResult = OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVLEGES Or TOKEN_QUERY, m_hToken)
    If nResult = 0 Then
        Err.Raise SITUATION_BASE + 1, , "Opening process token failed."
    End If
    'Restore-Struktur anfordern
    nResult = LookupPrivilegeValue(vbNullString, SE_RESTORE_NAME, m_RestoreLuid)
    If nResult = 0 Then
        Err.Raise SITUATION_BASE + 2, , "Looking up restore privilege failed."
    End If
    'BackUp-Struktur anfordern
    nResult = LookupPrivilegeValue(vbNullString, SE_BACKUP_NAME, m_BackupLuid)
    If nResult = 0 Then
        Err.Raise SITUATION_BASE + 3, , "Looking up backup privilege failed."
    End If
    'neue Privilegien einrichten
    m_TP.PrivilegeCount = 2
    m_TP.Privileges(0).pLuid = m_RestoreLuid
    m_TP.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
    m_TP.Privileges(1).pLuid = m_BackupLuid
    m_TP.Privileges(1).Attributes = SE_PRIVILEGE_ENABLED
    'geänderte Strukturen einstellen
    nResult = AdjustTokenPrivileges(m_hToken, vbFalse, m_TP, Len(m_TP), 0&, 0&)
    If nResult = 0 Then
        Err.Raise SITUATION_BASE + 4, , "Adjusting new privileges failed."
    End If
    Exit Sub
    
ErrHandler:
    If InStr(1, Err.Source, ":") = 0 Then Err.Source = "CCSysRegistry:setBackupAndRestorePriviliges"
    Err.Raise Err.Number
End Sub

Rechte wieder zurücknehmen

Private Sub resetBackupAndRestorePriviliges()
    '====================================================================================
    'Date:      2004-01-20
    'Function:  Privilegien wieder zurücknehmen
    '====================================================================================
    Dim nResult As Long             'Rückgabe der Funktionen
    On Error GoTo ErrHandler
    nResult = AdjustTokenPrivileges(m_hToken, vbTrue, m_TP, Len(m_TP), 0&, 0&)
    If nResult = 0 Then
        Err.Raise SITUATION_BASE + 5, , "Resetting new privileges failed."
    End If
    Exit Sub
    
ErrHandler:
    If InStr(1, Err.Source, ":") = 0 Then Err.Source = "CCSysRegistry:resetBackupAndRestorePriviliges"
    Err.Raise Err.Number
End Sub

getErrorMessage

Private Function getErrorMessage(ByVal nMessageID As Long) As String
    '====================================================================================
    'Date:      2000-08-23
    'Function:  Fehlertext ermitteln
    '------------------------------------------------------------------------------------
    'Arguments:
    '   nMessageID: FehlerCode in System Message Table
    '------------------------------------------------------------------------------------
    'Changes:
    '   2003-01-22  interne Fehler überarbeitet
    '====================================================================================
    Dim sError As String * 256      'Fehlertext
    Dim nResult As Long             'Rückgabe
    Dim nSize As Long               'Länge von sError
    On Error GoTo ErrHandler
    If nMessageID = 0 Then
        Err.Raise SITUATION_BASE + 7, , "'0' is a invalid message ID."
    End If
    nSize = 256
    nResult = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0&, nMessageID, 0&, sError, nSize, 0&)
    If nResult = 0 Then
        Err.Raise SITUATION_BASE + 8, , "Message '" & nMessageID & "' could not be found in System Message Table."
    Else
        GetErrorMessage = Left(sError, nResult - 1)
    End If
    Exit Function
ErrHandler:
    If InStr(1, Err.Source, ":") = 0 Then Err.Source = "CCSysRegistry:getErrorMessage"
    Err.Raise Err.Number
End Function