Attribute VB_Name = "modRegistry"
Option Explicit
'Key and HKey(Key Handle)
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006
'Value設定
Public Const REG_NONE = 0 '0 Nothing
Public Const REG_SZ = 1 '1 字串
Public Const REG_EXPAND_SZ = 2 '2 可開式字串
Public Const REG_BINARY = 3 '3 Binary資料
Public Const REG_DWORD = 4 '4 長整數
Public Const REG_DWORD_BIG_ENDIAN = 5 '5 Big Endian長整數
Public Const REG_MULTI_SZ = 7 '7 多重字串
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 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 RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue 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 RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Public Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData 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
Private Const ControlHKey As String = HKEY_CLASSES_ROOT
Sub SetRegistryValue(ControlPath As String, ControlValueName As String, ControlData As String)
Dim InsertHKey As Long
RegCreateKey ControlHKey, ControlPath, InsertHKey
RegSetValueEx InsertHKey, ControlValueName, 0, REG_SZ, ByVal ControlData, LenB(StrConv(ControlData, vbFromUnicode)) + 1
End Sub
Sub DeleteRegistryValue(ControlPath As String)
RegDeleteKey ControlHKey, ControlPath
End Sub
Function InquiryRegistryValue(ControlPath As String, ControlValueName As String) As String
Dim k As Integer
Dim InsertHKey As Long
Dim InfoCheck As Integer, InfoLength As Long, InfoString As String, InfoType As Long
InfoCheck = RegOpenKey(ControlHKey, ControlPath, InsertHKey)
If InfoCheck = 0 Then
InfoCheck = RegQueryValueEx(InsertHKey, ControlValueName, ByVal 0, InfoType, ByVal vbNullString, InfoLength)
InfoString = String(InfoLength, Chr(0))
RegQueryValueEx InsertHKey, ControlValueName, ByVal 0, InfoType, ByVal InfoString, InfoLength
Do Until Not Right(InfoString, 1) = Chr(0)
InfoString = Left(InfoString, Len(InfoString) - 1)
Loop
InquiryRegistryValue = InfoString
Else
InquiryRegistryValue = "fail"
End If
End Function
Function ExistedRegistryValue(ControlPath As String) As Boolean
Dim InfoCheck As Integer, InfoLength As Long, InfoString As String
InfoLength = 100
InfoString = String(InfoLength, Chr(0))
InfoCheck = RegQueryValue(ControlHKey, ControlPath, InfoString, InfoLength)
If InfoCheck = 0 Then ExistedRegistryValue = True Else ExistedRegistryValue = False
End Function
