Const ERROR_NO_MORE_ITEMS = 259&
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_CURRENT_USER = &H80000001
Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_BINARY = 3 ' Free form binary
 
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As _
  Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" ( _
ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" ( _
ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As _
Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, _
lpftLastWriteTime As Any) 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 Long) As Long
 
Dim hKey As Long, Cnt As Long, sName As String, sData As String, Ret As Long, _
  RetData As Long
Dim initkey As String
 
Private Sub Form_Load()
  Const BUFFER_SIZE As Long = 255
  Ret = BUFFER_SIZE
  initkey = "Software\Microsoft\Windows\CurrentVersion\Uninstall"
  If RegOpenKey(HKEY_LOCAL_MACHINE, initkey, hKey) <> 0 Then
    RegCloseKey hKey
    Exit Sub
  End If
  sName = Space(BUFFER_SIZE)
  RegOpenKey HKEY_LOCAL_MACHINE, initkey, hKey
  While RegEnumKeyEx(hKey, Cnt, sName, Ret, ByVal 0&, vbNullString, ByVal 0&, _
    ByVal 0&) <> ERROR_NO_MORE_ITEMS
      List1.AddItem "  " + Left$(sName, Ret)
      Cnt = Cnt + 1
      sName = Space(BUFFER_SIZE)
      Ret = BUFFER_SIZE
  Wend
  RegCloseKey hKey
End Sub
 
Private Sub List1_Click()
    Text1.Text = GetString(HKEY_LOCAL_MACHINE, initkey & "\" & Mid(List1.List( _
      List1.ListIndex), 3), "DisplayName")
End Sub
 
Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) _
  As String
    Dim lResult As Long, lValueType As Long, strBuf As String, lDataBufSize As _
    Long
    'retrieve nformation about the key
    lResult = RegQueryValueEx(hKey, strValueName, 0, lValueType, ByVal 0, _
      lDataBufSize)
    If lResult = 0 Then
        If lValueType = REG_SZ Then
            'Create a buffer
            strBuf = String(lDataBufSize, Chr$(0))
            'retrieve the key's content
            lResult = RegQueryValueEx(hKey, strValueName, 0, 0, ByVal strBuf, _
              lDataBufSize)
            If lResult = 0 Then
                'Remove the unnecessary chr$(0)'s
                RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - _
                  1)
            End If
        ElseIf lValueType = REG_BINARY Then
            Dim strData As Integer
            'retrieve the key's value
            lResult = RegQueryValueEx(hKey, strValueName, 0, 0, strData, _
              lDataBufSize)
            If lResult = 0 Then
                RegQueryStringValue = strData
            End If
        End If
    End If
End Function
Function GetString(hKey As Long, strPath As String, strValue As String)
    Dim Ret
    'Open the key
    RegOpenKey hKey, strPath, Ret
    'Get the key's content
    GetString = RegQueryStringValue(Ret, strValue)
    'Close the key
    RegCloseKey Ret
End Function

mfg
brave@heart

...bis zur unendlichkeit und noch viel weiter...