'Registry-Eintrag auslesen (String, "normaler" Eintrag)
'Beispiel:   Variable = GetSettingString(HKEY_LOCAL_MACHINE, 
' "Software\SHADOWare", "Eintrag", "Vorgabe")
'(die Vorgabe wird zurückgegeben, wenn der Eintrag nicht existiert)
Public Function GetSettingString(hKey As Long, strPath As String, strValue As _
  String, Optional Default As String) As String
   Dim hCurKey As Long
   Dim lValueType As Long
   Dim strBuffer As String
   Dim lDataBufferSize As Long
   Dim intZeroPos As Integer
   Dim lRegResult As Long
   If Not IsEmpty(Default) Then
     GetSettingString = Default
   Else
     GetSettingString = ""
   End If
   lRegResult = RegOpenKey(hKey, strPath, hCurKey)
   lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, lValueType, ByVal 0&, _
     lDataBufferSize)
   If lRegResult = ERROR_SUCCESS Then
      If lValueType = REG_SZ Then
         strBuffer = String(lDataBufferSize, " ")
         lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, 0&, ByVal _
           strBuffer, lDataBufferSize)
         intZeroPos = InStr(strBuffer, Chr$(0))
         If intZeroPos > 0 Then
            GetSettingString = Left$(strBuffer, intZeroPos - 1)
         Else
            GetSettingString = strBuffer
         End If
      End If
   Else
      'Irgendetwas ist schiefgegangen
   End If
   lRegResult = RegCloseKey(hCurKey)
End Function
'Registry-Eintrag anlegen/verändern (String, "normaler" Eintrag)
'Beispiel:   SaveSettingString HKEY_LOCAL_MACHINE, "Software\SHADOWare", 
' "Eintrag", "Wert"
Public Sub SaveSettingString(hKey As Long, strPath As String, strValue As _
  String, strData As String)
   Dim hCurKey As Long
   Dim lRegResult As Long   
   lRegResult = RegCreateKey(hKey, strPath, hCurKey)
   lRegResult = RegSetValueEx(hCurKey, strValue, 0, REG_SZ, ByVal strData, Len( _
     strData))
   If lRegResult <> ERROR_SUCCESS Then
      'Irgendetwas ist schiefgegangen
   End If
   lRegResult = RegCloseKey(hCurKey)
End Sub
'Registry-Eintrag auslesen (DWORD)
'Beispiel:   Variable = GetSettingLong(HKEY_LOCAL_MACHINE, 
' "Software\SHADOWare", "Eintrag", 1)
'(die Vorgabe(1) wird zurückgegeben, wenn der Eintrag nicht existiert)
Public Function GetSettingLong(ByVal hKey As Long, ByVal strPath As String, _
  ByVal strValue As String, Optional Default As Long) As Long
   Dim lRegResult As Long
   Dim lValueType As Long
   Dim lBuffer As Long
   Dim lDataBufferSize As Long
   Dim hCurKey As Long   
   If Not IsEmpty(Default) Then
     GetSettingLong = Default
   Else
     GetSettingLong = 0
   End If
   lRegResult = RegOpenKey(hKey, strPath, hCurKey)
   lDataBufferSize = 4       ' 4 bytes = 32 bits = long
   lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, lValueType, lBuffer, _
     lDataBufferSize)
   If lRegResult = ERROR_SUCCESS Then
      If lValueType = REG_DWORD Then
         GetSettingLong = lBuffer
      End If
   Else
      'Irgendetwas ist schiefgegangen
   End If
   lRegResult = RegCloseKey(hCurKey)
End Function
'Registry-Eintrag anlegen/verändern (DWORD)
'Beispiel:   SaveSettingLong HKEY_LOCAL_MACHINE, "Software\SHADOWare", 
' "Eintrag", 1
Public Sub SaveSettingLong(ByVal hKey As Long, ByVal strPath As String, ByVal _
  strValue As String, ByVal lData As Long)
   Dim hCurKey As Long
   Dim lRegResult As Long   
   lRegResult = RegCreateKey(hKey, strPath, hCurKey)
   lRegResult = RegSetValueEx(hCurKey, strValue, 0&, REG_DWORD, lData, 4)
   If lRegResult <> ERROR_SUCCESS Then
      'Irgendetwas ist schiefgegangen
   End If
   lRegResult = RegCloseKey(hCurKey)
End Sub
'Registry-Eintrag auslesen (Binär)
'Beispiel:   Variable = GetSettingByte(HKEY_LOCAL_MACHINE, 
' "Software\SHADOWare", "Eintrag", "Vorgabe")
'(die Vorgabe wird zurückgegeben, wenn der Eintrag nicht existiert)
Public Function GetSettingByte(ByVal hKey As Long, ByVal strPath As String, _
  ByVal strValueName As String, Optional Default As Variant) As Variant
   Dim lValueType As Long
   Dim byBuffer() As Byte
   Dim lDataBufferSize As Long
   Dim lRegResult As Long
   Dim hCurKey As Long   
   If Not IsEmpty(Default) Then
      If VarType(Default) = vbArray + vbByte Then
         GetSettingByte = Default
      Else
         GetSettingByte = 0
      End If
   Else
      GetSettingByte = 0
   End If
   lRegResult = RegOpenKey(hKey, strPath, hCurKey)
   lRegResult = RegQueryValueEx(hCurKey, strValueName, 0&, lValueType, ByVal _
     0&, lDataBufferSize)
   If lRegResult = ERROR_SUCCESS Then
      If lValueType = REG_BINARY Then
         ReDim byBuffer(lDataBufferSize - 1) As Byte
         lRegResult = RegQueryValueEx(hCurKey, strValueName, 0&, lValueType, _
           byBuffer(0), lDataBufferSize)
         GetSettingByte = byBuffer
      End If
   Else
      'Irgendetwas ist schiefgegangen
   End If
   lRegResult = RegCloseKey(hCurKey)
End Function

Probleme oder Fragen mit und ?ber den/m PC? Klappt was nicht?

......:::::X------www.insiders-xp.de------X:::::........