www.pudn.com > virtualdrivemapper.zip > cReg.cls
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "cReg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'/////////////////////////////////////////////////////////
'Copyright © 2001 B.O.O.P.S. Inc.
'BOOPS, Based On Other People's Stuff
'We don't code the source you download, we code it better.
'Original only in the synthesis.
'
'This program is based on Ian O'Connor's(oc@lineone.net) vb script file
'"Directory Mapping.vbs" with revisions by Neil Ramsbottom(nramsbottom@hotmail.com).
'It was included in the zip.
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Option Explicit
'This is just a generic reg class that I use. Had this not been the first release of this
'project I would have taken out everything that is not used.
'HKeys
Public Enum cRegConst
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_USER = &H80000001
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
End Enum
'Predefined Value Types
Public Enum cRegType
REG_SZ = (1) 'Unicode nul terminated string
REG_BINARY = (3) 'Free form binary
REG_DWORD = (4) '32-bit number
End Enum
'Structures Needed For Registry Prototypes
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Boolean
End Type
'Registry Specific Access Rights
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const KEY_ALL_ACCESS = &H3F '&H2003F
'Open/Create Options
Private Const REG_OPTION_NON_VOLATILE = 0&
Private Const REG_OPTION_VOLATILE = &H1
'Key creation/open disposition
Private Const REG_CREATED_NEW_KEY = &H1
Private Const REG_OPENED_EXISTING_KEY = &H2
'masks for the predefined standard access types
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const SPECIFIC_RIGHTS_ALL = &HFFFF
Private Const SYNCHRONIZE = &H100000
Private Const STANDARD_RIGHTS_READ = &H20000
Private Const STANDARD_RIGHTS_WRITE = &H20000
Private Const STANDARD_RIGHTS_EXECUTE = &H20000
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const KEY_READ = &H20019 '((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_NOTIFY) And (Not SYNCHRONIZE))
'Define severity codes
Private Const ERROR_SUCCESS = 0&
Private Const ERROR_ACCESS_DENIED = 5
Private Const ERROR_INVALID_DATA = 13&
Private Const ERROR_MORE_DATA = 234 ' dderror
Private Const ERROR_NO_MORE_ITEMS = 259
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData 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 RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExBinary Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Byte, ByVal cbData As Long) As Long 'ByRef lpData As Byte
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegQueryValueExBin 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 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 RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, 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
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, Source As Any, ByVal numBytes As Long)
'GetValue
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 Any) As Long
'/////////////////////////////////////////////////////////
Public Function CreateNewKey(lPredefinedKey As Long, sNewKeyName As String)
Dim hNewKey As Long
Dim lRetVal As Long
lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)
RegCloseKey (hNewKey)
End Function
Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
Dim lValue As Long
Dim sValue As String
Dim bValue() As Byte
Select Case lType
Case REG_SZ
sValue = vValue
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
Case REG_DWORD
lValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
Case REG_BINARY
bValue() = vValue
SetValueEx = RegSetValueExBinary(hKey, sValueName, 0&, lType, bValue(0), LBound(bValue))
End Select
End Function
Public Function SetKeyValue(hKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)
RegOpenKeyEx hKey, sKeyName, 0, KEY_ALL_ACCESS, hKey
SetValueEx hKey, sValueName, lValueType, vValueSetting
RegCloseKey (hKey)
End Function
Public Function QueryValueEx(ByVal hKey As Long, ByVal szValueName As String, vValue As Variant) As Long
Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String
Dim length As Long
Dim resBinary() As Byte
On Error GoTo QueryValueExError
lrc = RegQueryValueExNULL(hKey, szValueName, 0&, lType, 0&, cch)
If lrc <> ERROR_SUCCESS Then Error 5
Select Case lType
Case REG_SZ:
sValue = String(cch, 0)
lrc = RegQueryValueExString(hKey, szValueName, 0&, lType, sValue, cch)
If lrc = ERROR_SUCCESS Then
vValue = Left$(sValue, cch)
Else
vValue = Empty
End If
Case REG_DWORD:
lrc = RegQueryValueExLong(hKey, szValueName, 0&, lType, lValue, cch)
If lrc = ERROR_SUCCESS Then vValue = lValue
Case Else
lrc = "ERROR"
End Select
QueryValueExExit:
QueryValueEx = lrc
Exit Function
QueryValueExError:
Resume QueryValueExExit
End Function
Public Function qVal(hKey As Long, sKeyName As String, sValueName As String)
Dim lRetVal As Long
Dim handle As Long
Dim vValue As Variant
lRetVal = RegOpenKeyEx(hKey, sKeyName, 0, KEY_ALL_ACCESS, handle)
lRetVal = QueryValueEx(handle, sValueName, vValue)
'////
' when vb writes a value to the registry it adds a null value to the end of it. Why? I don't know.
' If quarying a non existant value this will invoke an error. So use "ValRegKey" first.
vValue = Mid$(vValue, 1, Len(vValue) - 1) 'Trim the ending null value, chr(0), aka "NULL".
'\\\\
qVal = vValue
RegCloseKey (handle)
End Function
Public Function DeleteKey(hKey As Long, sKeyName As String)
Dim lRetVal As Long
Dim handle As Long
lRetVal = RegOpenKeyEx(hKey, sKeyName, 0, KEY_ALL_ACCESS, handle)
lRetVal = RegDeleteKey(hKey, sKeyName)
RegCloseKey (handle)
End Function
Public Function DeleteValue(hKey As Long, KeyName As String, sValueName As String)
Dim lRetVal As Long
Dim handle As Long
lRetVal = RegOpenKeyEx(hKey, KeyName, 0, KEY_ALL_ACCESS, handle)
lRetVal = RegDeleteValue(hKey, sValueName)
RegCloseKey (handle)
End Function
'This just returns true if the given key exists.
Public Function ValRegKey(hKey As Long, KeyName As String, sValueName As String) As Boolean
Dim handle As Long
If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then
ValRegKey = False
Exit Function
Else
ValRegKey = True
RegCloseKey handle
End If
End Function
Public Function EnumRegKeys(ByVal hKey As Long, ByVal KeyName As String) As String()
Dim handle As Long, index As Long, length As Long
ReDim Result(0 To 100) As String
If Len(KeyName) Then
If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then
Exit Function
End If
hKey = handle
End If
For index = 0 To 1000
If index > UBound(Result) Then
ReDim Preserve Result(index + 99) As String
End If
length = 260
Result(index) = Space$(length)
If RegEnumKey(hKey, index, Result(index), length) Then Exit For
Result(index) = Left$(Result(index), InStr(Result(index), vbNullChar) - 1)
Next
If handle Then RegCloseKey handle
ReDim Preserve Result(index - 1) As String
EnumRegKeys = Result()
End Function
Public Function EnumRegVal(ByVal hKey As Long, ByVal KeyName As String) As Variant()
Dim handle As Long, index As Long, valueType As Long
Dim name As String, nameLen As Long
Dim lngValue As Long, strValue As String, dataLen As Long
ReDim Result(0 To 1, 0 To 100) As Variant
If Len(KeyName) Then
If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then Exit Function
hKey = handle
End If
For index = 0 To 1000
If index > UBound(Result, 2) Then
ReDim Preserve Result(0 To 1, index + 99) As Variant
End If
nameLen = 260
name = Space$(nameLen)
dataLen = 4096
ReDim binValue(0 To dataLen - 1) As Byte
If RegEnumValue(hKey, index, name, nameLen, ByVal 0&, valueType, binValue(0), dataLen) Then Exit For
Result(0, index) = Left$(name, nameLen)
Select Case valueType
Case REG_DWORD
CopyMemory lngValue, binValue(0), 4
Result(1, index) = lngValue
Case REG_SZ
Result(1, index) = Left$(StrConv(binValue(), vbUnicode), dataLen - 1)
Case Else
ReDim Preserve binValue(0 To dataLen - 1) As Byte
Result(1, index) = binValue()
End Select
Next
If handle Then RegCloseKey handle
If Result(0, index) = "" Then GoTo enumErr:
ReDim Preserve Result(0 To 1, index - 1) As Variant
EnumRegVal = Result()
enumErr:
ReDim Preserve Result(0 To 1, index) As Variant
EnumRegVal = Result()
End Function