:: vb : Class Modul Registry ::

Masukkan code dibawah ini sebagai class module: 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 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 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 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 Const ERROR_NONE = 0 Private Const ERROR_BADDB = 1 Private Const ERROR_BADKEY = 2 Private Const ERROR_CANTOPEN = 3 Private Const ERROR_CANTREAD = 4 Private Const ERROR_CANTWRITE = 5 Private Const ERROR_OUTOFMEMORY = 6 Private Const ERROR_INVALID_PARAMETER = 7 Private Const ERROR_ACCESS_DENIED = 8 Private Const ERROR_INVALID_PARAMETERS = 87 Private Const ERROR_NO_MORE_ITEMS = 259 Private Const KEY_ALL_ACCESS = &H3F Private Const KEY_QUERY_VALUE = &H1 Private Const REG_OPTION_NON_VOLATILE = 0 Private Const REG_SZ As Long = 1 Private Const REG_DWORD As Long = 4 Public Enum EnumProgramSettingsRoot psrHKEY_CLASSES_ROOT = &H80000000 psrHKEY_CURRENT_USER = &H80000001 psrHKEY_LOCAL_MACHINE = &H80000002 psrHKEY_USERS = &H80000003 End Enum Private m_lngRootKey As EnumProgramSettingsRoot Private m_strMainBranch As String Private m_strRegBase As String Private m_strProgram As String Private m_strSection As String Private Sub Class_Initialize() m_lngRootKey = psrHKEY_LOCAL_MACHINE m_strMainBranch = "SOFTWARE" m_strSection = "Settings" End Sub Public Property Get MainBranch() As String MainBranch = m_strMainBranch End Property Public Property Let MainBranch(strValue As String) m_strMainBranch = strValue End Property Public Property Get Program() As String Program = m_strProgram End Property Public Property Let Program(strValue As String) m_strProgram = strValue End Property Public Property Get RegBase() As String RegBase = m_strRegBase End Property Public Property Let RegBase(strValue As String) m_strRegBase = strValue End Property Public Property Get RootKey() As EnumProgramSettingsRoot RootKey = m_lngRootKey End Property Public Property Let RootKey(eValue As EnumProgramSettingsRoot) m_lngRootKey = eValue End Property Public Property Get Section() As String Section = m_strSection End Property Public Property Let Section(strValue As String) m_strSection = strValue End Property Public Function ReadEntry( _ strEntry As String, _ strDefault As String) _ As String Dim strValue As String Dim strSearch As String On Error GoTo PROC_ERR strSearch = m_strMainBranch & "" & _ m_strRegBase & "" & _ m_strProgram & "" & _ m_strSection strValue = GetKeyValue(m_lngRootKey, strSearch, strEntry) If strValue = "" Then ReadEntry = strDefault Else ReadEntry = strValue End If PROC_EXIT: Exit Function PROC_ERR: MsgBox "Error: " & Err.Number & ". " & Err.Description, , _ "ReadEntry" Resume PROC_EXIT End Function Public Sub WriteEntry( _ strEntry As String, _ strValue As String) Dim strSearch As String On Error GoTo PROC_ERR strSearch = m_strMainBranch & "" & _ m_strRegBase & "" & _ m_strProgram & "" & _ m_strSection SetKeyValue m_lngRootKey, strSearch, strEntry, strValue, REG_SZ PROC_EXIT: Exit Sub PROC_ERR: MsgBox "Error: " & Err.Number & ". " & Err.Description, , _ "WriteEntry" Resume PROC_EXIT End Sub Private Function GetKeyValue( _ eValue As EnumProgramSettingsRoot, _ strKeyName As String, _ strValueName As String) _ As Variant Dim lngReturnValue As Long Dim varValue As Variant Dim lngValueData As Long Dim lngDataSize As Long On Error GoTo PROC_ERR varValue = Empty lngReturnValue = RegOpenKeyEx( _ eValue, _ strKeyName, _ 0&, _ KEY_ALL_ACCESS, _ lngHKey) If ERROR_NONE = lngReturnValue Then lngReturnValue = RegQueryValueExNULL( _ lngHKey, _ strValueName, _ 0&, _ lngValueType, _ 0&, _ lngDataSize) If ERROR_NONE = lngReturnValue Then Select Case lngValueType Case REG_SZ: strValueData = String(lngDataSize, 0) lngReturnValue = RegQueryValueExString( _ lngHKey, _ strValueName, _ 0&, _ lngValueType, _ strValueData, _ lngDataSize) If ERROR_NONE = lngReturnValue Then If Len(strValueData) Then If Mid$(strValueData, lngDataSize, 1) = vbNullChar Then lngDataSize = lngDataSize - 1 End If varValue = Left$(strValueData, lngDataSize) Else varValue = "" End If Else varValue = Empty End If Case REG_DWORD: lngReturnValue = RegQueryValueExLong( _ lngHKey, _ strValueName, _ 0&, _ lngValueType, _ lngValueData, _ lngDataSize) If ERROR_NONE = lngReturnValue Then varValue = lngValueData End If Case Else lngReturnValue = True End Select End If RegCloseKey (lngHKey) End If GetKeyValue = varValue PROC_EXIT: Exit Function PROC_ERR: MsgBox "Error: " & Err.Number & ". " & Err.Description, , _ "GetKeyValue" Resume PROC_EXIT End Function Private Sub SetKeyValue( _ eValue As EnumProgramSettingsRoot, _ strKeyName As String, _ strValueName As String, _ varValue As Variant, _ lngValueType As Long) Dim lngReturnValue As Long Dim lngHKey As Long On Error GoTo PROC_ERR lngReturnValue = RegCreateKeyEx( _ eValue, _ strKeyName, _ 0&, _ vbNullString, _ REG_OPTION_NON_VOLATILE, _ KEY_ALL_ACCESS, _ 0&, _ lngHKey, _ 0&) Select Case lngValueType Case REG_SZ varValue = varValue & vbNullChar lngReturnValue = RegSetValueExString( _ lngHKey, _ strValueName, _ 0&, _ lngValueType, _ varValue, _ Len(varValue)) Case REG_DWORD lngReturnValue = RegSetValueExLong( _ lngHKey, _ strValueName, _ 0&, _ lngValueType, _ CLng(varValue), _ REG_DWORD) End Select RegCloseKey (lngHKey) PROC_EXIT: Exit Sub PROC_ERR: MsgBox "Error: " & Err.Number & ". " & Err.Description, , _ "SetKeyValue" Resume PROC_EXIT End Sub