VB 5/6-Tipp 0548: REG_MULTI_SZ Werte in Registry schreiben und lesen
von Jan Lohage
Beschreibung
Dieser Tipp zeigt, wie man mehrzeiligen Text in die Registry schreibt und diese Werte wierder ausliest.
Schwierigkeitsgrad: | Verwendete API-Aufrufe: RegCloseKey, RegCreateKeyExA (RegCreateKeyEx), RegDeleteKeyA (RegDeleteKey), RegDeleteValueA (RegDeleteValue), RegFlushKey, RegOpenKeyExA (RegOpenKeyEx), RegQueryValueExA (RegQueryValueEx), RegSetValueExA (RegSetValueEx), RegSetValueExA (RegSetValueEx_Str) | Download: |
'Dieser Quellcode stammt von http://www.activevb.de 'und kann frei verwendet werden. Für eventuelle Schäden 'wird nicht gehaftet. 'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum. 'Ansonsten viel Spaß und Erfolg mit diesem Source! '------------- Anfang Projektdatei Projekt1.vbp ------------- '--------- Anfang Formular "Form1" alias Form1.frm --------- ' Steuerelement: Schaltfläche "Command2" ' Steuerelement: Schaltfläche "Command1" ' Steuerelement: Textfeld "Text2" ' Steuerelement: Textfeld "Text1" ' Steuerelement: Beschriftungsfeld "Label2" ' Steuerelement: Beschriftungsfeld "Label1" (Index von 0 bis 1) Option Explicit Private Sub Form_Load() Dim Result As Long Label2.Caption = "Dieses Beispiel verwendet den Schlüssel ""HKEY_CURRENT_USER\Software\VB""" Command1.Caption = "Auslesen" Command2.Caption = "Schreiben" Result = Registry.RegKeyExist(HKEY_CURRENT_USER, "Software\" & _ "VB and VBA Program Settings\ActiveVB") 'wenn der Key nicht existiert If Result = 2 Then 'neuen REG_MULTI_SZ-Key erstellen mit dem Wert 1 2 3 Registry.RegValueSet HKEY_CURRENT_USER, "Software\VB and VBA " & _ "Program Settings", "ActiveVB", "1" & vbCrLf & "2" & vbCrLf & _ "3", True, True End If End Sub Private Sub Command1_Click() Dim Result As Long, Text As String Result = Registry.RegValueGet(HKEY_CURRENT_USER, "Software\" & _ "VB and VBA Program Settings", "ActiveVB", Text) Text1.Text = Text Debug.Print Result End Sub Private Sub Command2_Click() Dim Result As Long, Text As String If Text2 = "" Then MsgBox "Bitte einen Wert eingeben", vbCritical Exit Sub End If Text = Text2.Text Registry.RegValueSet HKEY_CURRENT_USER, "Software" & _ "\VB and VBA Program Settings", "ActiveVB", Text End Sub '---------- Ende Formular "Form1" alias Form1.frm ---------- '-------- Anfang Modul "Registry" alias Registry.bas -------- Option Explicit 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 RegCloseKey Lib "advapi32.dll" _ (ByVal hKey As Long) As Long Private Declare Function RegQueryValueEx Lib "advapi32.dll" _ Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal _ lpValueName As String, ByVal lpReserved As Long, _ lpType As Long, lpData As Any, lpcbData As Any) 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 Any, _ phkResult As Long, lpdwDisposition As Long) As Long Private Declare Function RegFlushKey Lib "advapi32.dll" (ByVal _ hKey As Long) As Long Private Declare Function RegSetValueEx Lib "advapi32.dll" _ Alias "RegSetValueExA" (ByVal hKey As Long, ByVal _ lpValueName As String, ByVal Reserved As Long, ByVal _ dwType As Long, lpData As Long, ByVal cbData As Long) _ As Long Private Declare Function RegSetValueEx_Str Lib "advapi32.dll" _ Alias "RegSetValueExA" (ByVal hKey As Long, ByVal _ lpValueName As String, ByVal Reserved As Long, ByVal _ dwType As Long, ByVal lpData As String, ByVal cbData As _ Long) As Long Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias _ "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As _ String) As Long Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias _ "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName _ As String) As Long Public Enum HKEY_ROOTS HKEY_CLASSES_ROOT = &H80000000 HKEY_CURRENT_USER = &H80000001 HKEY_LOCAL_MACHINE = &H80000002 HKEY_USERS = &H80000003 HKEY_PERFORMANCE_DATA = &H80000004 HKEY_CURRENT_CONFIG = &H80000005 HKEY_DYN_DATA = &H80000006 End Enum Const KEY_QUERY_VALUE = &H1 Const KEY_SET_VALUE = &H2 Const KEY_CREATE_SUB_KEY = &H4 Const KEY_ENUMERATE_SUB_KEYS = &H8 Const KEY_NOTIFY = &H10 Const KEY_CREATE_LINK = &H20 Const KEY_READ = KEY_QUERY_VALUE Or _ KEY_ENUMERATE_SUB_KEYS _ Or KEY_NOTIFY Const KEY_ALL_ACCESS = KEY_QUERY_VALUE Or _ KEY_SET_VALUE Or _ KEY_CREATE_SUB_KEY Or _ KEY_ENUMERATE_SUB_KEYS Or _ KEY_NOTIFY Or _ KEY_CREATE_LINK Const ERROR_SUCCESS = 0& Const REG_NONE = 0 Const REG_SZ = 1 Const REG_EXPAND_SZ = 2 Const REG_BINARY = 3 Const REG_DWORD = 4 Const REG_DWORD_LITTLE_ENDIAN = 4 Const REG_DWORD_BIG_ENDIAN = 5 Const REG_LINK = 6 Const REG_MULTI_SZ = 7 Const REG_OPTION_NON_VOLATILE = &H0 Private RegRoot As Long Public Function RegKeyExist(Root As HKEY_ROOTS, Key$) As Long Dim Result As Long, hKey As Long 'Prüfen ob ein Schlüssel existiert Result = RegOpenKeyEx(Root, Key, 0, KEY_READ, hKey) If Result = ERROR_SUCCESS Then Call RegCloseKey(hKey) RegKeyExist = Result End Function Public Function RegKeyCreate(Root As HKEY_ROOTS, Newkey$) As Long Dim Result As Long, hKey As Long, Back As Long 'Neuen Schlüssel erstellen Result = RegCreateKeyEx(Root, Newkey, 0, vbNullString, _ REG_OPTION_NON_VOLATILE, _ KEY_ALL_ACCESS, 0&, hKey, Back) If Result = ERROR_SUCCESS Then Result = RegFlushKey(hKey) If Result = ERROR_SUCCESS Then Call RegCloseKey(hKey) RegKeyCreate = Back End If End Function Public Function RegKeyDelete(Root As HKEY_ROOTS, Key$) As Long 'Schlüssel erstellen RegKeyDelete = RegDeleteKey(Root, Key) End Function Public Function RegFieldDelete(Root As HKEY_ROOTS, Key$, Field$) As Long Dim Result As Long, hKey As Long 'Feld löschen Result = RegOpenKeyEx(Root, Key, 0, KEY_ALL_ACCESS, hKey) If Result = ERROR_SUCCESS Then Result = RegDeleteValue(hKey, Field) Result = RegCloseKey(hKey) End If RegFieldDelete = Result End Function Public Function RegValueSet(Root As HKEY_ROOTS, Key$, Field$, Value As Variant, _ Optional ReplaceVBCrLf As Boolean = True, _ Optional Create As Boolean = True) As Long Dim Result As Long, hKey As Long, s As String Dim l As Long, FoundNullChars As Boolean 'Wenn der Key nicht existiert, dann erstellen If Not RegKeyExist(Root, Key) And Create = True Then RegKeyCreate Root, Key End If If InStr(1, Value, vbCrLf) And ReplaceVBCrLf Then Value = Replace(Value, vbCrLf, vbNullChar) FoundNullChars = True End If 'Wert in ein Feld der Registry schreiben Result = RegOpenKeyEx(Root, Key, 0, KEY_ALL_ACCESS, hKey) If Result = ERROR_SUCCESS Then Select Case VarType(Value) Case vbInteger, vbLong l = CLng(Value) Result = RegSetValueEx(hKey, Field, 0, REG_DWORD, l, 4) Case vbString If FoundNullChars Then s = CStr(Value) Result = RegSetValueEx_Str(hKey, Field, 0, REG_MULTI_SZ, s, _ Len(s)) Else s = CStr(Value) Result = RegSetValueEx_Str(hKey, Field, 0, REG_SZ, s, _ Len(s)) End If End Select Result = RegCloseKey(hKey) End If RegValueSet = Result End Function Public Function RegValueGet(Root As HKEY_ROOTS, Key$, Field$, Value As Variant) As Long Dim Result As Long, hKey As Long, dwType As Long Dim Lng As Long, Buffer As String, l As Long 'Wert aus einem Feld der Registry auslesen Result = RegOpenKeyEx(Root, Key, 0, KEY_READ, hKey) If Result = ERROR_SUCCESS Then Result = RegQueryValueEx(hKey, Field, 0&, dwType, ByVal 0&, l) If Result = ERROR_SUCCESS Then Select Case dwType Case REG_SZ Buffer = Space$(l) Result = RegQueryValueEx(hKey, Field, 0&, _ dwType, ByVal Buffer, l) If Result = ERROR_SUCCESS Then Value = Buffer Case REG_DWORD Result = RegQueryValueEx(hKey, Field, 0&, dwType, Lng, l) If Result = ERROR_SUCCESS Then Value = Lng Case REG_MULTI_SZ Buffer = Space$(l) Result = RegQueryValueEx(hKey, Field, 0&, _ dwType, ByVal Buffer, l) Buffer = Replace(Buffer, vbNullChar, vbCrLf) If Result = ERROR_SUCCESS Then Value = Buffer End Select End If End If If Result = ERROR_SUCCESS Then Result = RegCloseKey(hKey) RegValueGet = Result End Function '--------- Ende Modul "Registry" alias Registry.bas --------- '-------------- Ende Projektdatei Projekt1.vbp --------------
Tipp-Kompatibilität:
Windows/VB-Version | Win32s | Win95 | Win98 | WinME | WinNT4 | Win2000 | WinXP |
VB4 | |||||||
VB5 | |||||||
VB6 |
Ihre Meinung
Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.
Archivierte Nutzerkommentare
Klicken Sie diesen Text an, wenn Sie die 4 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.
Kommentar von Patrick am 17.12.2003 um 09:49
Sollte bei REG_MULTI_SZ Werten nicht folgendes stehen?
Buffer = Space$(l) '+ 1 in Klammer weglassen
und
Result = RegSetValueEx_Str(hKey, Field, 0, REG_MULTI_SZ, s, Len(s)) 'ebenso das + 1 weglassen
Beim lesen und späteren zurückspeichern sind dann 2 Zeichen zuviel, oder???
Kommentar von Peter Sühlo am 09.12.2003 um 16:05
Ich habe den Sourcecode für ein spezielles Problem unter VBA für MS Access 97 unter NT 4.0 reduziert und es hat funktioniert. Danke.
PS: Wenn man nicht Administrator ist, sollte man beim Schreiben in die Registry statt KEY_ALL_ACCESS lieber den speziellen Wert KEY_SET_VALUE (in der Funktion RegOpenKeyEx) verwenden, sonst kann es ein Problem geben.
Kommentar von Jan Lohage am 17.05.2003 um 16:46
aber mit der methode kann man keine werte an beliebigen stellen der registry ändern/erstellen
Jan
Kommentar von garth am 13.12.2002 um 00:18
siet komplieziert aus der code zur registry ich habe und nutze da einen einfacheren
Public UTextname
Public Sub ReadRegistry()
UTextname = GetSetting("Programname", "Personal Information", "Textname", "")
End Sub
Public Sub SaveRegistry()
Call SaveSetting("Programname", "Personal Information", "Textname", UTextname)
End Sub