Registry Editing

Hey Guys,

Here is some code that I am using to access the registry. So far it works fine if I am editing a string value but does not seem to work on DWORD values. Can someone point me in the right direction?

SaveSetting appname, section, key, setting

GetSetting(appname, section, key[, default])

 

Hey Everyone,

I found that I would not be able edit the registry on the level
that I would like to with just using the GetSetting() and
SaveSetting() functions. However, I found a module that
encompassed all of the functions that I was looking for,
including string and dword editing and removal amoung others.
ENJOY!

Enum RegHive
HKEY_CLASSES_ROOT = &H80000000
HK_CR = &H80000000
HKEY_CURRENT_USER = &H80000001
HK_CU = &H80000001
HKEY_LOCAL_MACHINE = &H80000002
HK_LM = &H80000002
HKEY_USERS = &H80000003
HK_US = &H80000003
HKEY_CURRENT_CONFIG = &H80000005
HK_CC = &H80000005
HKEY_DYN_DATA = &H80000006
HK_DD = &H80000006
End Enum

Enum RegType
REG_SZ = 1 'Unicode nul terminated string
REG_BINARY = 3 'Free form binary
REG_DWORD = 4 '32-bit number
End Enum

Public Const ERROR_SUCCESS = 0&
Public Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" _
Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As
String, _
phkResult As Long) As Long
Public Declare Function RegDeleteKey Lib "advapi32.dll" _
Alias "RegDeleteKeyA" (ByVal hKey As Long, _
ByVal lpSubKey As String) As Long
Public Declare Function RegDeleteValue Lib "advapi32.dll" _
Alias "RegDeleteValueA" (ByVal hKey As Long, _
ByVal lpValueName As String) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" _
Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As
String, _
phkResult As Long) As Long
Public 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
Public Declare Function RegSetValueEx Lib "advapi32.dll" _
Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName
As String, _
ByVal Reserved As Long, ByVal dwType As Long, lpData As Any,
_
ByVal cbData As Long) As Long
Public 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

Public Function DelRegValue(ByVal hKey As RegHive, ByVal strPath
As String, _
ByVal strValue As String)
Dim hCurKey As Long
Dim lRegResult As Long
lRegResult = RegOpenKey(hKey, strPath, hCurKey)
lRegResult = RegDeleteValue(hCurKey, strValue)
lRegResult = RegCloseKey(hCurKey)
End Function

Public Function DelRegKey(ByVal hKey As RegHive, ByVal strPath As
String) As Long
Dim lRegResult As Long
lRegResult = RegDeleteKey(hKey, strPath)
DelRegKey = lRegResult
End Function

Public Function CreateRegKey(hKey As RegHive, strPath As String)
Dim hCurKey As Long
Dim lRegResult As Long
lRegResult = RegCreateKey(hKey, strPath, hCurKey)
If lRegResult <> ERROR_SUCCESS Then
'there is a problem
End If
lRegResult = RegCloseKey(hCurKey)
End Function
Public Function GetRegString(hKey As RegHive, strPath As String,
_
strValue As String, Optional Default As String) As String
Dim hCurKey As Long
Dim lResult As Long
Dim lValueType As Long
Dim strBuffer As String
Dim lDataBufferSize As Long
Dim intZeroPos As Integer
Dim lRegResult As Long
'Set up default value
If Not IsEmpty(Default) Then
GetRegString = Default
Else
GetRegString = ""
End If
lRegResult = RegOpenKey(hKey, strPath, hCurKey)
lRegResult = RegQueryValueEx(hCurKey, strValue, 0&,
lValueType, _
ByVal 0&, lDataBufferSize)
If lRegResult = ERROR_SUCCESS Then
If lValueType = REG_SZ Then
strBuffer = String(lDataBufferSize, " ")
lResult = RegQueryValueEx(hCurKey, strValue, 0&, 0&,
_
ByVal strBuffer, lDataBufferSize)
intZeroPos = InStr(strBuffer, Chr$(0))
If intZeroPos > 0 Then
GetRegString = Left$(strBuffer, intZeroPos -
1)
Else
GetRegString = strBuffer
End If
End If
Else
'there is a problem
End If
lRegResult = RegCloseKey(hCurKey)
End Function

Public Function SaveRegString(hKey As RegHive, strPath As String,
_
strValue As String, strData As String)
Dim hCurKey As Long
Dim lRegResult As Long
lRegResult = RegCreateKey(hKey, strPath, hCurKey)
lRegResult = RegSetValueEx(hCurKey, strValue, 0, REG_SZ, _
ByVal strData, Len(strData))
If lRegResult <> ERROR_SUCCESS Then
'there is a problem
End If
lRegResult = RegCloseKey(hCurKey)
End Function

Public Function GetRegLong(ByVal hKey As RegHive, ByVal strPath
As String, _
ByVal strValue As String, Optional Default As Long) As Long
Dim lRegResult As Long
Dim lValueType As Long
Dim lBuffer As Long
Dim lDataBufferSize As Long
Dim hCurKey As Long
'Set up default value
If Not IsEmpty(Default) Then
GetRegLong = Default
Else
GetRegLong = 0
End If
lRegResult = RegOpenKey(hKey, strPath, hCurKey)
lDataBufferSize = 4 '4 bytes = 32 bits = long
lRegResult = RegQueryValueEx(hCurKey, strValue, 0&,
lValueType, lBuffer, _
lDataBufferSize)
If lRegResult = ERROR_SUCCESS Then
If lValueType = REG_DWORD Then
GetRegLong = lBuffer
End If
Else
'there is a problem
End If
lRegResult = RegCloseKey(hCurKey)
End Function

Public Function SaveRegLong(ByVal hKey As RegHive, ByVal strPath
As String, _
ByVal strValue As String, ByVal lData As Long)
Dim hCurKey As Long
Dim lRegResult As Long
lRegResult = RegCreateKey(hKey, strPath, hCurKey)
lRegResult = RegSetValueEx(hCurKey, strValue, 0&, REG_DWORD,
lData, 4)
If lRegResult <> ERROR_SUCCESS Then
'there is a problem
End If
lRegResult = RegCloseKey(hCurKey)
End Function

Public Function GetRegByte(ByVal hKey As RegHive, ByVal strPath
As String, _
ByVal strValueName As String, Optional Default As Variant) As
Variant
Dim lValueType As Long
Dim byBuffer() As Byte
Dim lDataBufferSize As Long
Dim lRegResult As Long
Dim hCurKey As Long
If Not IsEmpty(Default) Then
If VarType(Default) = vbArray + vbByte Then
GetRegByte = Default
Else
GetRegByte = 0
End If
Else
GetRegByte = 0
End If
lRegResult = RegOpenKey(hKey, strPath, hCurKey)
lRegResult = RegQueryValueEx(hCurKey, strValueName, 0&,
lValueType, _
ByVal 0&, lDataBufferSize)
If lRegResult = ERROR_SUCCESS Then
If lValueType = REG_BINARY Then
ReDim byBuffer(lDataBufferSize - 1) As Byte
lRegResult = RegQueryValueEx(hCurKey, strValueName,
0&, lValueType, _
byBuffer(0), lDataBufferSize)
GetRegByte = byBuffer
End If
Else
'there is a problem
End If
lRegResult = RegCloseKey(hCurKey)
End Function

Public Function SaveRegByte(ByVal hKey As RegHive, ByVal strPath
As String, _
ByVal strValueName As String, byData() As Byte)
Dim lRegResult As Long
Dim hCurKey As Long
lRegResult = RegCreateKey(hKey, strPath, hCurKey)
lRegResult = RegSetValueEx(hCurKey, strValueName, 0&,
REG_BINARY, _
byData(0), UBound(byData()) + 1)
lRegResult = RegCloseKey(hCurKey)
End Function

Public Function CopyRegByte(ByVal From_hKey As RegHive, _
ByVal From_strPath As String, ByVal From_strKeyName As
String, _
ByVal To_strPath As String, Optional ByVal To_hKey As
RegHive, _
Optional ByVal To_strKeyName As String)

If To_hKey = 0 Then
To_hKey = From_hKey
Else
To_hKey = To_hKey
End If
If To_strKeyName = "" Then
To_strKeyName = From_strKeyName
Else
To_strKeyName = To_strKeyName
End If

Dim mybytes As Variant
mybytes = GetRegByte(From_hKey, From_strPath,
From_strKeyName)
thelen = UBound(mybytes)
Dim x() As Byte
ReDim x(thelen)
For i = 0 To UBound(mybytes)
x(i) = mybytes(i)
Next i
rslt = SaveRegByte(To_hKey, To_strPath, To_strKeyName, x)
End Function

Public Function CopyRegString(ByVal From_hKey As RegHive, _
ByVal From_strPath As String, ByVal From_strKeyName As
String, _
ByVal To_strPath As String, Optional ByVal To_hKey As
RegHive, _
Optional ByVal To_strKeyName As String)

If To_hKey = 0 Then
To_hKey = From_hKey
Else
To_hKey = To_hKey
End If
If To_strKeyName = "" Then
To_strKeyName = From_strKeyName
Else
To_strKeyName = To_strKeyName
End If

Dim mystring As String
mystring = GetRegString(From_hKey, From_strPath,
From_strKeyName)
rslt = SaveRegString(To_hKey, To_strPath, To_strKeyName,
mystring)

End Function

Public Function CopyRegLong(ByVal hKey As RegHive, ByVal
From_strPath As String, _
ByVal From_strKeyName As String, ByVal To_strPath As String,
_
Optional ByVal To_hKey As RegHive, Optional ByVal
To_strKeyName As String)

If To_hKey = 0 Then
To_hKey = From_hKey
Else
To_hKey = To_hKey
End If
If To_strKeyName = "" Then
To_strKeyName = From_strKeyName
Else
To_strKeyName = To_strKeyName
End If

Dim mylong As Long
mylong = GetRegLong(From_hKey, From_strPath,
From_strKeyName)
rslt = SaveRegLong(To_hKey, To_strPath, To_strKeyName,
mylong)

End Function
Public Function GetRegSubKeyList(ByVal hKey As RegHive, ByVal
strPath As String)
On Error Resume Next
Dim lResult As Long, lKeyValue As Long, lDataTypeValue As Long,
lValueLength As Long
Dim sValue As String, td As Double, i As Long, Ret As Boolean,
tmprst()
Do Until Ret = True
lResult = RegOpenKey(hKey, strPath, lKeyValue)
sValue = Space$(2048)
lValueLength = Len(sValue)
lResult = RegEnumKey(lKeyValue, i, sValue, lValueLength)
If (lResult = 0) And (Err.Number = 0) Then
ReDim Preserve tmprst(i)
tmprst(i) = Left$(sValue, InStr(sValue, Chr(0)) - 1)
Else
Ret = True
End If
lResult = RegCloseKey(lKeyValue)
i = i + 1
Loop
GetRegSubKeyList = tmprst
End Function