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
' Modifications: 11/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 Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003
Private Const HKEY_PERFORMANCE_DATA = &H80000004
Private Const HKEY_CURRENT_CONFIG = &H80000005
Private Const KEY_ALL_ACCESS = &H3F
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(HKEY_LOCAL_MACHINE, 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(HKEY_LOCAL_MACHINE, 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
'
' Some valid shell folders are:
'
' Favorites - Location of all the Favorite shortcuts
' Desktop - Location of the current desktop
' Programs - Location of the Programs option on the Start Menu
' SendTo - Location where the items that appear on the Send To menu are stored
' Start Menu - Location of the Start Menu icons and folders
' Cache - Location of the temporary internet files
' Personal - Location of the My Documents folder (which doesn't really have to be
' called My Documents
' Recent - Shortcuts to all the recently open files
' Startup - Location of the StartUp menu folder (typically under Programs)
'
'
Public Function ShellFolderPath(sFolderName As String) As Variant
On Error GoTo ErrorHandler
Const EXPLORER_KEY_NAME As String = "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders"
Dim lRetVal As Long, hKey As Long, vValue As Variant
lRetVal = RegOpenKeyEx(HKEY_CURRENT_USER, EXPLORER_KEY_NAME, 0, KEY_ALL_ACCESS, hKey)
lRetVal = GetKeyValue(hKey, sFolderName, vValue)
RegCloseKey hKey
ShellFolderPath = vValue
ExitFunction:
On Error GoTo 0
Exit Function
ErrorHandler:
ShellFolderPath = 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