您的位置:首页 > 其它

[转贴]Rename Registry Key

2009-02-28 04:40 239 查看
转自http://www.hbsoft.de/net/tipps/renreg.aspx

Rename Registry Key Leserbewertung (5):












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.NumberEnd 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.NumberEnd 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.NumberEnd 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.NumberEnd Function
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: