Imports System
Imports System. Runtime. InteropServices
Imports System. Text
Public Class cRegistry
Public Shared Function CreateKey (ByVal strhkeyName As String, ByVal keyName As String) As Integer
Dim hkey As IntPtr = IntPtr. Zero
Dim disposition As Integer = 0
Try
Return RegCreateKeyEx (intPtrkeyName (strhkeyName), keyName, 0, Nothing, 0, KeyAccess. None, IntPtr. Zero, hkey, disposition)
Finally
If IntPtr. Zero. ToInt32 () <> hkey. ToInt32 () Then
RegCloseKey (hkey)
End If
End Try
End Function
Public Shared Function DeleteKey (ByVal keyName As String) As Integer
Return RegDeleteKey (HKCU, keyName)
End Function 'deletekey
Public Shared Function intPtrkeyName (ByVal strhkeyName As String) As IntPtr
Select Case strhkeyName
Case "HKCR": intPtrkeyName = New IntPtr (& H80000000)
Case "HKCU": intPtrkeyName = New IntPtr (& H80000001)
Case "HKLM": intPtrkeyName = New IntPtr (& H80000002)
Case "HKU": intPtrkeyName = New IntPtr (& H80000003)
End Select
End Function
Public Shared Function CreateValueString (ByVal strhkeyName As String, ByVal keyName As String, ByVal valueName As String, ByVal stringData As String) As Integer
Dim hkey As IntPtr = IntPtr. Zero
Try
Dim result As Integer = RegOpenKeyEx (intPtrkeyName (strhkeyName), keyName, 0, KeyAccess. None, hkey)
If ERROR_SUCCESS <> result Then
Return result
End If
Dim bytes As Byte () = Encoding. Unicode. GetBytes (stringData & Chr (0 ))
Return RegSetValueEx (hkey, valueName, 0, KeyType. StringKey, bytes, bytes. Length)
Finally
If IntPtr. Zero. ToInt32 () <> hkey. ToInt32 () Then
RegCloseKey (hkey)
End If
End Try
End Function 'createvaluestring
Public Shared Function CreateValueDWORD (ByVal strhkeyName As String, ByVal keyName As String, ByVal valueName As String, ByVal dwordData As Integer) As Integer
Dim hkey As IntPtr = IntPtr. Zero
Try
Dim result As Integer = RegOpenKeyEx (intPtrkeyName (strhkeyName), keyName, 0, KeyAccess. None, hkey)
If ERROR_SUCCESS <> result Then
Return result
End If
Dim bytes As Byte () = BitConverter. GetBytes (dwordData)
Return RegSetValueEx (hkey, valueName, 0, KeyType. DwordKey, bytes, bytes. Length)
Finally
If IntPtr. Zero. ToInt32 () <> hkey. ToInt32 () Then
RegCloseKey (hkey)
End If
End Try
End Function 'createvaluedword
Public Shared Function GetStringValue (ByVal strhkeyName As String, ByVal keyName As String, ByVal valueName As String, ByRef stringResult As String) As Integer
Dim hkey As IntPtr = IntPtr. Zero
Try
Dim result As Integer = RegOpenKeyEx (intPtrkeyName (strhkeyName), keyName, 0, KeyAccess. None, hkey)
If ERROR_SUCCESS <> result Then
Return result
End If
Dim bytes As Byte () = Nothing
Dim length As Integer = 0
Dim keyType As KeyType = keyType. NoKey
Result = RegQueryValueEx (hkey, valueName, IntPtr. Zero, keyType, Nothing, length)
If ERROR_SUCCESS <> result Then
Return result
End If
KeyType = keyType. NoKey
Bytes = New Byte (length ){}
Result = RegQueryValueEx (hkey, valueName, IntPtr. Zero, keyType, bytes, length)
If ERROR_SUCCESS <> result Then
Return result
End If
StringResult = Encoding. Unicode. GetString (bytes, 0, bytes. Length)
Return ERROR_SUCCESS
Finally
If IntPtr. Zero. ToInt32 () <> hkey. ToInt32 () Then
RegCloseKey (hkey)
End If
End Try
End Function 'getstringvalue
Public Shared Function GetDWORDValue (ByVal strhkeyName As String, ByVal keyName As String, ByVal valueName As String, ByRef dwordResult As Integer) As Integer
Dim hkey As IntPtr = IntPtr. Zero
Try
Dim result As Integer = RegOpenKeyEx (intPtrkeyName (strhkeyName), keyName, 0, KeyAccess. None, hkey)
If ERROR_SUCCESS <> result Then
Return result
End If
Dim bytes As Byte () = Nothing
Dim length As Integer = 0' ToDo: Unsigned Integers not supported
Dim keyType As KeyType = keyType. NoKey
Result = RegQueryValueEx (hkey, valueName, IntPtr. Zero, keyType, Nothing, length)
Bytes = New Byte (Marshal. SizeOf (GetType (System. Int32 ))){}
Length = bytes. Length
KeyType = keyType. NoKey
Result = RegQueryValueEx (hkey, valueName, IntPtr. Zero, keyType, bytes, length)
If ERROR_SUCCESS <> result Then
Return result
End If
DwordResult = BitConverter. ToInt32 (bytes, 0)
Return ERROR_SUCCESS
Finally
If IntPtr. Zero. ToInt32 () <> hkey. ToInt32 () Then
RegCloseKey (hkey)
End If
End Try
End Function 'getdwordvalue
Public Shared Function DeleteValue (ByVal strhkeyName As String, ByVal keyName As String, ByVal valueName As String) As Integer
Dim hkey As IntPtr = IntPtr. Zero
Try
Dim result As Integer = RegOpenKeyEx (intPtrkeyName (strhkeyName), keyName, 0, KeyAccess. None, hkey)
If ERROR_SUCCESS <> result Then
Return result
End If
Return RegDeleteValue (hkey, valueName)
Finally
If IntPtr. Zero. ToInt32 () <> hkey. ToInt32 () Then
RegCloseKey (hkey)
End If
End Try
End Function 'deletealue
Public Enum KeyType
NoKey = 0
StringKey = 1
DwordKey = 4
End Enum
Public Enum KeyAccess
None = & H0
QueryValue = & H1
SetValue = & H2
CreateSubKey = & H4
EnumerateSubKeys = & H8
Required y = & H10
CreateLink = & H20
End Enum
Public Shared HKCR As New IntPtr (& H80000000)
Public Shared HKCU As New IntPtr (& H80000001)
Public Shared HKLM As New IntPtr (& H80000002)
Public Shared HKU As New IntPtr (& H80000003)
Public Const ERROR_SUCCESS As Integer = 0
<DllImport ("coredll. dll", SetLastError: = True)> _
Public Shared Function RegCreateKeyEx (ByVal hkey As IntPtr, ByVal lpSubKey As String, ByVal Reserved As Integer, ByVal lpClass As StringBuilder, ByVal dwOptions As Integer, ByVal samDesired As KeyAccess, ByVal stored As IntPtr, byRef phkResult As IntPtr, ByRef lpdwDisposition As Integer) As Integer
End Function
<DllImport ("coredll. dll", SetLastError: = True)> _
Public Shared Function RegDeleteKey (ByVal hkey As IntPtr, ByVal subkeyName As String) As Integer
End Function
<DllImport ("coredll. dll", SetLastError: = True)> _
Public Shared Function RegOpenKeyEx (ByVal hkey As IntPtr, ByVal lpSubKey As String, ByVal ulOptions As Integer, ByVal samDesired As KeyAccess, ByRef phkResult As IntPtr) As Integer
End Function
<DllImport ("coredll. dll", SetLastError: = True)> _
Public Shared Function RegQueryValueEx (ByVal hkey As IntPtr, ByVal lpValueName As String, ByVal lpReserved As IntPtr, ByRef lpType As KeyType, ByVal lpData () As Byte, ByRef lpcbData As Integer) As Integer
End Function
<DllImport ("coredll. dll", SetLastError: = True)> _
Public Shared Function RegSetValueEx (ByVal hkey As IntPtr, ByVal lpValueName As String, ByVal Reserved As Integer, ByVal dwType As KeyType, ByVal lpData () As Byte, ByVal cbData As Integer) As Integer
End Function
<DllImport ("coredll. dll", SetLastError: = True)> _
Public Shared Function RegDeleteValue (ByVal hkey As IntPtr, ByVal valueName As String) As Integer
End Function
<DllImport ("coredll. dll", SetLastError: = True)> _
Public Shared Function RegCloseKey (ByVal hkey As IntPtr) As Integer
End Function
End Class