Visual Basic Registry Routines
RegQueryValueEx: Windows Registered Owner Information
Posted:   Sunday December 01, 2002
Updated:   Monday December 26, 2011
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows XP
OS restrictions:   None
Author:   VBnet - Randy Birch


RegEnumKeyEx: Retrieve the Registered File Associations
RegEnumKeyEx: Retrieve Windows Uninstallable Application List

Quick sample showing how to retrieve Windows' registered owner and company, product name and product ID key (partly masked in the illustration) from the registry .
 BAS Module Code

 Form Code
Add a single command button (Command1), and two control arrays -- a single text box with its Index property set to 0 (Text1(0)), and a single label with its index property set to 0 (Label1(0)). The Load event creates the required controls for the demo. Add the following code:

Option Explicit
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
Private Const VER_PLATFORM_WIN32_WINDOWS  As Long = 1
Private Const VER_PLATFORM_WIN32_NT  As Long = 2
Private Const HKEY_LOCAL_MACHINE  As Long = &H80000002
Private Const REG_SZ As Long = 1
Private Const ERROR_MORE_DATA = 234
Private Const ERROR_SUCCESS As Long = 0
Private Const KEY_QUERY_VALUE As Long = &H1
Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
Private Const KEY_NOTIFY As Long = &H10
Private Const STANDARD_RIGHTS_READ As Long = &H20000
Private Const SYNCHRONIZE As Long = &H100000
Private Const KEY_READ As Long = ((STANDARD_RIGHTS_READ Or _
                                   KEY_QUERY_VALUE Or _
                                   KEY_ENUMERATE_SUB_KEYS Or _
                                   KEY_NOTIFY) And _
                                   (Not SYNCHRONIZE))
'windows-defined type OSVERSIONINFO
  OSVSize         As Long
  dwVerMajor      As Long
  dwVerMinor      As Long
  dwBuildNumber   As Long
  PlatformID      As Long
  szCSDVersion    As String * 128
End Type

'private type for holding results
Private Type WindowsRegistryInfo
  RegOwner    As String
  RegCompany  As String
  Product     As String
  ProductId   As String
End Type

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 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

Private Declare Function RegCloseKey Lib "advapi32.dll" _
  (ByVal hKey As Long) As Long
Private Declare Function GetVersionEx Lib "kernel32" _
   Alias "GetVersionExA" _
  (lpVersionInformation As OSVERSIONINFO) As Long

Private Declare Function lstrlenW Lib "kernel32" _
  (ByVal lpString As Long) As Long

Private Sub Form_Load()

  Dim cnt As Long
  Dim TotalRequired As Long
  TotalRequired = 4

 'control array is 0-based, so 
 'last is TotalRequired -1
  For cnt = 0 To TotalRequired - 1
     'index item 0 already exists
      If cnt > 0 Then
         Load Label1(cnt)
         Load Text1(cnt)
      End If
     'position the newly-created control
      Label1(cnt).Move 200, 330 + (cnt * 300)
      Text1(cnt).Move 2000, 300 + (cnt * 300)
     'and show
      Label1(cnt).Visible = True
      Text1(cnt).Visible = True

  Label1(0) = "Registered Owner :"
  Label1(1) = "Registered Company :"
  Label1(2) = "Product Name :"
  Label1(3) = "Product Id :"
  Command1.Caption = "Reg Info"
End Sub

Private Sub Command1_Click()
   Dim wri As WindowsRegistryInfo
   Call GetRegistryInfo(wri)
   Text1(0).Text = wri.RegOwner
   Text1(1).Text = wri.RegCompany
   Text1(2).Text = wri.Product
   Text1(3).Text = wri.ProductId
End Sub
Private Sub GetRegistryInfo(wri As WindowsRegistryInfo)

   Dim hKey As Long
   Dim regPath As String
  'the path to the registered owner and company
  'differ in Win9x and NT, so dwPlatformID
  'is used to distinguish between the two.
   osv.OSVSize = Len(osv)
   Call GetVersionEx(osv)
   Select Case osv.PlatformID
         regPath = "SOFTWARE\Microsoft\Windows\CurrentVersion"
         regPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"
      Case Else
         MsgBox "GetVersion says this isn't 9x or NT!"
         Exit Sub
   End Select
  'Before reading a value from the reg
  'the key to read must first be opened.
  'hKey contains the handle used in
  'subsequent calls.
   hKey = OpenRegKey(HKEY_LOCAL_MACHINE, regPath)

   If hKey <> 0 Then
      wri.RegOwner = GetRegValue(hKey, "RegisteredOwner")
      wri.RegCompany = GetRegValue(hKey, "RegisteredOrganization")
      wri.Product = GetRegValue(hKey, "ProductName")
      wri.ProductId = GetRegValue(hKey, "ProductId")
     'the opened key must be closed
      Call RegCloseKey(hKey)
  End If

End Sub

Private Function GetRegValue(hSubKey As Long, sKeyName As String) As String

   Dim lpValue As String   'value retrieved
   Dim lpcbData As Long    'length of retrieved string

  'if valid
   If hSubKey <> 0 Then
     'Pass an zero-length string to
     'obtain the required buffer size
     'required to return the result.
     'If the key passed exists, the call
     'will return error 234 (more data)
     'and lpcbData will indicate the
     'required buffer size (including
     'the terminating null).
      lpValue = ""
      lpcbData = 0
      If RegQueryValueEx(hSubKey, _
                         sKeyName, _
                         0&, _
                         0&, _
                         ByVal lpValue, _
                         lpcbData) = ERROR_MORE_DATA Then

         lpValue = Space$(lpcbData)
        'retrieve the desired value
         If RegQueryValueEx(hSubKey, _
                            sKeyName, _
                            0&, _
                            0&, _
                            ByVal lpValue, _
                            lpcbData) = ERROR_SUCCESS Then
            GetRegValue = TrimNull(lpValue)
         End If  'If RegQueryValueEx (second call)
      End If  'If RegQueryValueEx (first call)
   End If  'If hSubKey

End Function

Private Function OpenRegKey(ByVal hKey As Long, _
                            ByVal lpSubKey As String) As Long

  Dim hSubKey As Long

  If RegOpenKeyEx(hKey, _
                  lpSubKey, _
                  0, _
                  KEY_READ, _
                  hSubKey) = ERROR_SUCCESS Then

      OpenRegKey = hSubKey

  End If

End Function

Private Function TrimNull(startstr As String) As String

   TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))
End Function


PayPal Link
Make payments with PayPal - it's fast, free and secure!


Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy


Hit Counter