Visual Basic Programming Code Examples

Reading and writing to the Registry (everywhere you want) 'use the Registry 'on a Module Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey as Long) as Long 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 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 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, lpSecurityAttributes as Long, phkResult as Long, lpdwDisposition as Long) as Long Declare Function RegCreateKey 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, lpSecurityAttributes as Long, phkResult as Long, lpdwDisposition as Long) as Long 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 Byte, ByVal cbData as Long) as Long 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 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 Public Const HKEY_CLASSES_ROOT = &H80000000 Public Const HKEY_CURRENT_CONFIG = &H80000005 Public Const HKEY_CURRENT_USER = &H80000001 Public Const HKEY_DYN_DATA = &H80000006 Public Const HKEY_LOCAL_MACHINE = &H80000002 Public Const HKEY_PERFORMANCE_DATA = &H80000004 Public Const HKEY_USERS = &H80000003 Public Const ERROR_SUCCESS = 0& Const REG_OPTION_NON_VOLATILE = &O0 Const KEY_ALL_CLASSES as long = &HF0063 Const KEY_ALL_ACCESS = &H3F Const REG_SZ as long = 1 'KeyName$ is youre own key in the Registry Public Const KeyName$ = "Software\KATHER\" Public sub SchrijfInstelling(SName$, KName$, vInstelling$) dim hNewKey as Long dim lRetVal as Long 'make key under HKEY_CURRENT_USER\Software\KATHER\applicationname\SName$ lRetVal = RegCreateKeyEx(&H80000001, KeyName & App.EXEName & "\" & SName$, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal) 'add avlue lRetVal = SetValueEx(hNewKey, KName$, REG_SZ, vInstelling$) RegCloseKey (hNewKey) End Sub Public Function LeesInstelling(SName$, KName$) as String LeesInstelling = RegGetString$(&H80000001, KeyName$ & App.EXEName & "\" & SName$, KName$) End Function Public Function RegGetString$(hInKey as Long, ByVal subkey$, ByVal valname$) dim RetVal$, hSubKey as Long, dwType as Long, SZ as Long, v$, r as Long RetVal$ = "" r = RegOpenKeyEx(hInKey, subkey$, 0, KEY_ALL_CLASSES, hSubKey) If r <> ERROR_SUCCESS Then GoTo Quit_Now SZ = 256: v$ = String$(SZ, 0) r = RegQueryValueEx(hSubKey, valname$, 0, dwType, ByVal v$, SZ) If r = ERROR_SUCCESS And dwType = REG_SZ Then RetVal$ = Left(v$, SZ - 1) Else RetVal$ = "" end If If hInKey = 0 Then r = RegCloseKey(hSubKey) Quit_Now: RegGetString$ = RetVal$ End Function Public Function SetValueEx(ByVal hKey as Long, sValueName as String, lType as Long, vValue as Variant) as Long SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, vValue, Len(vValue)) End Function 'Use as: Dim name$ Const = VSector$ = "options" 'reading name$ = LeesInstelling(vSector$,"name") 'writing Call SchrijfInstelling(VSector$,"name",name$) 'give the value off vKey$ and the settings in LeesInstelling and SchrijfInstelling 'the entry in the Registry will be: 'HKEY_CURRENT_USER\Software\KATHER\[applicationname]\options\name Return