Just paste this code into any class and change the name of the class to cRegistryUtils.
'----------------------------------------------------------------------
'
' Module Name: cRegistryUtils
' Written By: C&D Programming Corp.
' Albert Perdomo
' Create Date: 2/21/98
' Copyright: Copyright 1998 by C&D Programming Corp. Source
' code may not be reproduced except for use in a
' compiled executable. All rights reserved. If
' you would like to reprint any or all of this
' code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
'
' This class contains functions to retrieve the Organization
' and Registered User in Windows 95. It might work under
' Windows NT, but we didn't have a Windows NT machine to test on
' at the moment.
'
'
Option Explicit
'
' Key where the Organization and User Registration information is stored
'
Const WINDOWS_KEY_NAME As String = "SOFTWARE\Microsoft\Windows\CurrentVersion\"
'
' Various API declarations that need to be called to retrieve registry
' information.
'
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, phkResult As _
Long) As Long
Private Declare Function RegQueryValueExString Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
As String, lpcbData As Long) As Long
Private Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
As Long, lpcbData As Long) As Long
'
' Retrieves the registered user information from the registry.
' If it is not found, it will return an empty string.
'
Public Function RegisteredUser() As Variant
On Error GoTo ErrorHandler
Dim lRetVal As Long, hKey As Long, vValue As Variant
lRetVal = RegOpenKeyEx(&H80000002, WINDOWS_KEY_NAME, 0, &H3F, hKey)
lRetVal = GetKeyValue(hKey, "RegisteredOwner", vValue)
RegCloseKey hKey
RegisteredUser = vValue
ExitFunction:
On Error GoTo 0
Exit Function
ErrorHandler:
RegisteredUser = Empty
Resume ExitFunction
End Function
'
' Retrieves the registered organization information from the
' registry. If it is not found, it will return an empty string.
'
Public Function Organization() As Variant
On Error GoTo ErrorHandler
Dim lRetVal As Long, hKey As Long, vValue As Variant
lRetVal = RegOpenKeyEx(&H80000002, WINDOWS_KEY_NAME, 0, &H3F, hKey)
lRetVal = GetKeyValue(hKey, "RegisteredOrganization", vValue)
RegCloseKey hKey
Organization = vValue
ExitFunction:
On Error GoTo 0
Exit Function
ErrorHandler:
Organization = Empty
Resume ExitFunction
End Function
Private Function GetKeyValue(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
Dim cch As Long, lrc As Long
Dim lType As Long, lValue As Long
Dim sValue As String
' Determine the size and type of data to be read
lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
If lrc = 0 Then
sValue = String(cch, 0)
lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
If lrc = 0 Then
vValue = Left$(sValue, cch - 1)
Else
vValue = Empty
End If
GetKeyValue = lrc
Else
GetKeyValue = 0
End If
End Function