| 1 |
Attribute VB_Name = "basRegistry" |
| 2 |
' by Kenneth Ives: http://www.codetoad.com/vb_modify_registry.asp |
| 3 |
|
| 4 |
Option Explicit |
| 5 |
|
| 6 |
' -------------------------------------------------------------- |
| 7 |
' Update the Windows registry. |
| 8 |
' Written by Kenneth Ives kenaso@home.com |
| 9 |
' NT tested by Brett Gerhardi Brett.Gerhardi@trinite.co.uk |
| 10 |
' |
| 11 |
' Perform the four basic functions on the Windows registry. |
| 12 |
' Add |
| 13 |
' Change |
| 14 |
' Delete |
| 15 |
' Query |
| 16 |
' |
| 17 |
' Important: If you treat all key data strings as being |
| 18 |
' case sensitive, you should never have a problem. |
| 19 |
' Always backup your registry files (System.dat |
| 20 |
' and User.dat) before performing any type of |
| 21 |
' modifications |
| 22 |
' |
| 23 |
' Software developers vary on where they want to update the |
| 24 |
' registry with their particular information. The most common |
| 25 |
' are in HKEY_lOCAL_MACHINE or HKEY_CURRENT_USER. |
| 26 |
' |
| 27 |
' This BAS module handles all of my needs for string and |
| 28 |
' basic numeric updates in the Windows registry. |
| 29 |
' |
| 30 |
' Brett found that NT users must delete each major key |
| 31 |
' separately. See bottom of TEST routine for an example. |
| 32 |
' -------------------------------------------------------------- |
| 33 |
|
| 34 |
' -------------------------------------------------------------- |
| 35 |
' Private variables |
| 36 |
' -------------------------------------------------------------- |
| 37 |
Private m_lngRetVal As Long |
| 38 |
|
| 39 |
' -------------------------------------------------------------- |
| 40 |
' Constants required for values in the keys |
| 41 |
' -------------------------------------------------------------- |
| 42 |
Private Const REG_NONE As Long = 0 ' No value type |
| 43 |
Private Const REG_SZ As Long = 1 ' nul terminated string |
| 44 |
Private Const REG_EXPAND_SZ As Long = 2 ' nul terminated string w/enviornment var |
| 45 |
Private Const REG_BINARY As Long = 3 ' Free form binary |
| 46 |
Private Const REG_DWORD As Long = 4 ' 32-bit number |
| 47 |
Private Const REG_DWORD_LITTLE_ENDIAN As Long = 4 ' 32-bit number (same as REG_DWORD) |
| 48 |
Private Const REG_DWORD_BIG_ENDIAN As Long = 5 ' 32-bit number |
| 49 |
Private Const REG_LINK As Long = 6 ' Symbolic Link (unicode) |
| 50 |
Private Const REG_MULTI_SZ As Long = 7 ' Multiple Unicode strings |
| 51 |
Private Const REG_RESOURCE_LIST As Long = 8 ' Resource list in the resource map |
| 52 |
Private Const REG_FULL_RESOURCE_DESCRIPTOR As Long = 9 ' Resource list in the hardware description |
| 53 |
Private Const REG_RESOURCE_REQUIREMENTS_LIST As Long = 10 |
| 54 |
|
| 55 |
' -------------------------------------------------------------- |
| 56 |
' Registry Specific Access Rights |
| 57 |
' -------------------------------------------------------------- |
| 58 |
Private Const KEY_QUERY_VALUE As Long = &H1 |
| 59 |
Private Const KEY_SET_VALUE As Long = &H2 |
| 60 |
Private Const KEY_CREATE_SUB_KEY As Long = &H4 |
| 61 |
Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8 |
| 62 |
Private Const KEY_NOTIFY As Long = &H10 |
| 63 |
Private Const KEY_CREATE_LINK As Long = &H20 |
| 64 |
Private Const KEY_ALL_ACCESS As Long = &H3F |
| 65 |
|
| 66 |
' -------------------------------------------------------------- |
| 67 |
' Constants required for key locations in the registry |
| 68 |
' -------------------------------------------------------------- |
| 69 |
Public Const HKEY_CLASSES_ROOT As Long = &H80000000 |
| 70 |
Public Const HKEY_CURRENT_USER As Long = &H80000001 |
| 71 |
Public Const HKEY_LOCAL_MACHINE As Long = &H80000002 |
| 72 |
Public Const HKEY_USERS As Long = &H80000003 |
| 73 |
Public Const HKEY_PERFORMANCE_DATA As Long = &H80000004 |
| 74 |
Public Const HKEY_CURRENT_CONFIG As Long = &H80000005 |
| 75 |
Public Const HKEY_DYN_DATA As Long = &H80000006 |
| 76 |
|
| 77 |
' -------------------------------------------------------------- |
| 78 |
' Constants required for return values (Error code checking) |
| 79 |
' -------------------------------------------------------------- |
| 80 |
Private Const ERROR_SUCCESS As Long = 0 |
| 81 |
Private Const ERROR_ACCESS_DENIED As Long = 5 |
| 82 |
Private Const ERROR_NO_MORE_ITEMS As Long = 259 |
| 83 |
|
| 84 |
' -------------------------------------------------------------- |
| 85 |
' Open/Create constants |
| 86 |
' -------------------------------------------------------------- |
| 87 |
Private Const REG_OPTION_NON_VOLATILE As Long = 0 |
| 88 |
Private Const REG_OPTION_VOLATILE As Long = &H1 |
| 89 |
|
| 90 |
' -------------------------------------------------------------- |
| 91 |
' Declarations required to access the Windows registry |
| 92 |
' -------------------------------------------------------------- |
| 93 |
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal lngRootKey As Long) As Long |
| 94 |
|
| 95 |
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" _ |
| 96 |
(ByVal lngRootKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long |
| 97 |
|
| 98 |
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _ |
| 99 |
(ByVal lngRootKey As Long, ByVal lpSubKey As String) As Long |
| 100 |
|
| 101 |
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _ |
| 102 |
(ByVal lngRootKey As Long, ByVal lpValueName As String) As Long |
| 103 |
|
| 104 |
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" _ |
| 105 |
(ByVal lngRootKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long |
| 106 |
|
| 107 |
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _ |
| 108 |
(ByVal lngRootKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _ |
| 109 |
lpType As Long, lpData As Any, lpcbData As Long) As Long |
| 110 |
|
| 111 |
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _ |
| 112 |
(ByVal lngRootKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _ |
| 113 |
ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long |
| 114 |
|
| 115 |
Public Function regDelete_Sub_Key(ByVal lngRootKey As Long, _ |
| 116 |
ByVal strRegKeyPath As String, _ |
| 117 |
ByVal strRegSubKey As String) |
| 118 |
|
| 119 |
' -------------------------------------------------------------- |
| 120 |
' Written by Kenneth Ives kenaso@home.com |
| 121 |
' |
| 122 |
' Important: If you treat all key data strings as being |
| 123 |
' case sensitive, you should never have a problem. |
| 124 |
' Always backup your registry files (System.dat |
| 125 |
' and User.dat) before performing any type of |
| 126 |
' modifications |
| 127 |
' |
| 128 |
' Description: Function for removing a sub key. |
| 129 |
' |
| 130 |
' Parameters: |
| 131 |
' lngRootKey - HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, |
| 132 |
' HKEY_lOCAL_MACHINE, HKEY_USERS, etc |
| 133 |
' strRegKeyPath - is name of the key path you wish to traverse. |
| 134 |
' strRegSubKey - is the name of the key which will be removed. |
| 135 |
' |
| 136 |
' Syntax: |
| 137 |
' regDelete_Sub_Key HKEY_CURRENT_USER, _ |
| 138 |
"Software\AAA-Registry Test\Products", "StringTestData" |
| 139 |
' |
| 140 |
' Removes the sub key "StringTestData" |
| 141 |
' -------------------------------------------------------------- |
| 142 |
|
| 143 |
' -------------------------------------------------------------- |
| 144 |
' Define variables |
| 145 |
' -------------------------------------------------------------- |
| 146 |
Dim lngKeyHandle As Long |
| 147 |
|
| 148 |
' -------------------------------------------------------------- |
| 149 |
' Make sure the key exist before trying to delete it |
| 150 |
' -------------------------------------------------------------- |
| 151 |
If regDoes_Key_Exist(lngRootKey, strRegKeyPath) Then |
| 152 |
|
| 153 |
' Get the key handle |
| 154 |
m_lngRetVal = RegOpenKey(lngRootKey, strRegKeyPath, lngKeyHandle) |
| 155 |
|
| 156 |
' Delete the sub key. If it does not exist, then ignore it. |
| 157 |
m_lngRetVal = RegDeleteValue(lngKeyHandle, strRegSubKey) |
| 158 |
|
| 159 |
' Always close the handle in the registry. We do not want to |
| 160 |
' corrupt the registry. |
| 161 |
m_lngRetVal = RegCloseKey(lngKeyHandle) |
| 162 |
End If |
| 163 |
|
| 164 |
End Function |
| 165 |
|
| 166 |
Public Function regDoes_Key_Exist(ByVal lngRootKey As Long, _ |
| 167 |
ByVal strRegKeyPath As String) As Boolean |
| 168 |
|
| 169 |
' -------------------------------------------------------------- |
| 170 |
' Written by Kenneth Ives kenaso@home.com |
| 171 |
' |
| 172 |
' Important: If you treat all key data strings as being |
| 173 |
' case sensitive, you should never have a problem. |
| 174 |
' Always backup your registry files (System.dat |
| 175 |
' and User.dat) before performing any type of |
| 176 |
' modifications |
| 177 |
' |
| 178 |
' Description: Function to see if a key does exist |
| 179 |
' |
| 180 |
' Parameters: |
| 181 |
' lngRootKey - HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, |
| 182 |
' HKEY_lOCAL_MACHINE, HKEY_USERS, etc |
| 183 |
' strRegKeyPath - is name of the key path you want to test |
| 184 |
' |
| 185 |
' Syntax: |
| 186 |
' strKeyQuery = regQuery_A_Key(HKEY_CURRENT_USER, _ |
| 187 |
' "Software\AAA-Registry Test\Products") |
| 188 |
' |
| 189 |
' Returns the value of TRUE or FALSE |
| 190 |
' -------------------------------------------------------------- |
| 191 |
|
| 192 |
' -------------------------------------------------------------- |
| 193 |
' Define variables |
| 194 |
' -------------------------------------------------------------- |
| 195 |
Dim lngKeyHandle As Long |
| 196 |
|
| 197 |
' -------------------------------------------------------------- |
| 198 |
' Initialize variables |
| 199 |
' -------------------------------------------------------------- |
| 200 |
lngKeyHandle = 0 |
| 201 |
|
| 202 |
' -------------------------------------------------------------- |
| 203 |
' Query the key path |
| 204 |
' -------------------------------------------------------------- |
| 205 |
m_lngRetVal = RegOpenKey(lngRootKey, strRegKeyPath, lngKeyHandle) |
| 206 |
|
| 207 |
' -------------------------------------------------------------- |
| 208 |
' If no key handle was found then there is no key. Leave here. |
| 209 |
' -------------------------------------------------------------- |
| 210 |
If lngKeyHandle = 0 Then |
| 211 |
regDoes_Key_Exist = False |
| 212 |
Else |
| 213 |
regDoes_Key_Exist = True |
| 214 |
End If |
| 215 |
|
| 216 |
' -------------------------------------------------------------- |
| 217 |
' Always close the handle in the registry. We do not want to |
| 218 |
' corrupt these files. |
| 219 |
' -------------------------------------------------------------- |
| 220 |
m_lngRetVal = RegCloseKey(lngKeyHandle) |
| 221 |
|
| 222 |
End Function |
| 223 |
|
| 224 |
Public Function regQuery_A_Key(ByVal lngRootKey As Long, _ |
| 225 |
ByVal strRegKeyPath As String, _ |
| 226 |
ByVal strRegSubKey As String) As Variant |
| 227 |
|
| 228 |
' -------------------------------------------------------------- |
| 229 |
' Written by Kenneth Ives kenaso@home.com |
| 230 |
' |
| 231 |
' Important: If you treat all key data strings as being |
| 232 |
' case sensitive, you should never have a problem. |
| 233 |
' Always backup your registry files (System.dat |
| 234 |
' and User.dat) before performing any type of |
| 235 |
' modifications |
| 236 |
' |
| 237 |
' Description: Function for querying a sub key value. |
| 238 |
' |
| 239 |
' Parameters: |
| 240 |
' lngRootKey - HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, |
| 241 |
' HKEY_lOCAL_MACHINE, HKEY_USERS, etc |
| 242 |
' strRegKeyPath - is name of the key path you wish to traverse. |
| 243 |
' strRegSubKey - is the name of the key which will be queryed. |
| 244 |
' |
| 245 |
' Syntax: |
| 246 |
' strKeyQuery = regQuery_A_Key(HKEY_CURRENT_USER, _ |
| 247 |
' "Software\AAA-Registry Test\Products", _ |
| 248 |
"StringTestData") |
| 249 |
' |
| 250 |
' Returns the key value of "StringTestData" |
| 251 |
' -------------------------------------------------------------- |
| 252 |
|
| 253 |
' -------------------------------------------------------------- |
| 254 |
' Define variables |
| 255 |
' -------------------------------------------------------------- |
| 256 |
Dim intPosition As Integer |
| 257 |
Dim lngKeyHandle As Long |
| 258 |
Dim lngDataType As Long |
| 259 |
Dim lngBufferSize As Long |
| 260 |
Dim lngBuffer As Long |
| 261 |
Dim strBuffer As String |
| 262 |
|
| 263 |
' -------------------------------------------------------------- |
| 264 |
' Initialize variables |
| 265 |
' -------------------------------------------------------------- |
| 266 |
lngKeyHandle = 0 |
| 267 |
lngBufferSize = 0 |
| 268 |
|
| 269 |
' -------------------------------------------------------------- |
| 270 |
' Query the key path |
| 271 |
' -------------------------------------------------------------- |
| 272 |
m_lngRetVal = RegOpenKey(lngRootKey, strRegKeyPath, lngKeyHandle) |
| 273 |
|
| 274 |
' -------------------------------------------------------------- |
| 275 |
' If no key handle was found then there is no key. Leave here. |
| 276 |
' -------------------------------------------------------------- |
| 277 |
If lngKeyHandle = 0 Then |
| 278 |
regQuery_A_Key = "" |
| 279 |
m_lngRetVal = RegCloseKey(lngKeyHandle) ' always close the handle |
| 280 |
Exit Function |
| 281 |
End If |
| 282 |
|
| 283 |
' -------------------------------------------------------------- |
| 284 |
' Query the registry and determine the data type. |
| 285 |
' -------------------------------------------------------------- |
| 286 |
m_lngRetVal = RegQueryValueEx(lngKeyHandle, strRegSubKey, 0&, _ |
| 287 |
lngDataType, ByVal 0&, lngBufferSize) |
| 288 |
|
| 289 |
' -------------------------------------------------------------- |
| 290 |
' If no key handle was found then there is no key. Leave. |
| 291 |
' -------------------------------------------------------------- |
| 292 |
If lngKeyHandle = 0 Then |
| 293 |
regQuery_A_Key = "" |
| 294 |
m_lngRetVal = RegCloseKey(lngKeyHandle) ' always close the handle |
| 295 |
Exit Function |
| 296 |
End If |
| 297 |
|
| 298 |
' -------------------------------------------------------------- |
| 299 |
' Make the API call to query the registry based on the type |
| 300 |
' of data. |
| 301 |
' -------------------------------------------------------------- |
| 302 |
Select Case lngDataType |
| 303 |
Case REG_SZ: ' String data (most common) |
| 304 |
' Preload the receiving buffer area |
| 305 |
strBuffer = Space(lngBufferSize) |
| 306 |
|
| 307 |
m_lngRetVal = RegQueryValueEx(lngKeyHandle, strRegSubKey, 0&, 0&, _ |
| 308 |
ByVal strBuffer, lngBufferSize) |
| 309 |
|
| 310 |
' If NOT a successful call then leave |
| 311 |
If m_lngRetVal <> ERROR_SUCCESS Then |
| 312 |
regQuery_A_Key = "" |
| 313 |
Else |
| 314 |
' Strip out the string data |
| 315 |
intPosition = InStr(1, strBuffer, Chr(0)) ' look for the first null char |
| 316 |
If intPosition > 0 Then |
| 317 |
' if we found one, then save everything up to that point |
| 318 |
regQuery_A_Key = Left(strBuffer, intPosition - 1) |
| 319 |
Else |
| 320 |
' did not find one. Save everything. |
| 321 |
regQuery_A_Key = strBuffer |
| 322 |
End If |
| 323 |
End If |
| 324 |
|
| 325 |
Case REG_DWORD: ' Numeric data (Integer) |
| 326 |
m_lngRetVal = RegQueryValueEx(lngKeyHandle, strRegSubKey, 0&, lngDataType, _ |
| 327 |
lngBuffer, 4&) ' 4& = 4-byte word (long integer) |
| 328 |
|
| 329 |
' If NOT a successful call then leave |
| 330 |
If m_lngRetVal <> ERROR_SUCCESS Then |
| 331 |
regQuery_A_Key = "" |
| 332 |
Else |
| 333 |
' Save the captured data |
| 334 |
regQuery_A_Key = lngBuffer |
| 335 |
End If |
| 336 |
|
| 337 |
Case Else: ' unknown |
| 338 |
regQuery_A_Key = "" |
| 339 |
End Select |
| 340 |
|
| 341 |
' -------------------------------------------------------------- |
| 342 |
' Always close the handle in the registry. We do not want to |
| 343 |
' corrupt these files. |
| 344 |
' -------------------------------------------------------------- |
| 345 |
m_lngRetVal = RegCloseKey(lngKeyHandle) |
| 346 |
|
| 347 |
End Function |
| 348 |
Public Sub regCreate_Key_Value(ByVal lngRootKey As Long, ByVal strRegKeyPath As String, _ |
| 349 |
ByVal strRegSubKey As String, varRegData As Variant) |
| 350 |
|
| 351 |
' -------------------------------------------------------------- |
| 352 |
' Written by Kenneth Ives kenaso@home.com |
| 353 |
' |
| 354 |
' Important: If you treat all key data strings as being |
| 355 |
' case sensitive, you should never have a problem. |
| 356 |
' Always backup your registry files (System.dat |
| 357 |
' and User.dat) before performing any type of |
| 358 |
' modifications |
| 359 |
' |
| 360 |
' Description: Function for saving string data. |
| 361 |
' |
| 362 |
' Parameters: |
| 363 |
' lngRootKey - HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, |
| 364 |
' HKEY_lOCAL_MACHINE, HKEY_USERS, etc |
| 365 |
' strRegKeyPath - is name of the key path you wish to traverse. |
| 366 |
' strRegSubKey - is the name of the key which will be updated. |
| 367 |
' varRegData - Update data. |
| 368 |
' |
| 369 |
' Syntax: |
| 370 |
' regCreate_Key_Value HKEY_CURRENT_USER, _ |
| 371 |
' "Software\AAA-Registry Test\Products", _ |
| 372 |
' "StringTestData", "22 Jun 1999" |
| 373 |
' |
| 374 |
' Saves the key value of "22 Jun 1999" to sub key "StringTestData" |
| 375 |
' -------------------------------------------------------------- |
| 376 |
|
| 377 |
' -------------------------------------------------------------- |
| 378 |
' Define variables |
| 379 |
' -------------------------------------------------------------- |
| 380 |
Dim lngKeyHandle As Long |
| 381 |
Dim lngDataType As Long |
| 382 |
Dim lngKeyValue As Long |
| 383 |
Dim strKeyValue As String |
| 384 |
|
| 385 |
' -------------------------------------------------------------- |
| 386 |
' Determine the type of data to be updated |
| 387 |
' -------------------------------------------------------------- |
| 388 |
If IsNumeric(varRegData) Then |
| 389 |
lngDataType = REG_DWORD |
| 390 |
Else |
| 391 |
lngDataType = REG_SZ |
| 392 |
End If |
| 393 |
|
| 394 |
' -------------------------------------------------------------- |
| 395 |
' Query the key path |
| 396 |
' -------------------------------------------------------------- |
| 397 |
m_lngRetVal = RegCreateKey(lngRootKey, strRegKeyPath, lngKeyHandle) |
| 398 |
|
| 399 |
' -------------------------------------------------------------- |
| 400 |
' Update the sub key based on the data type |
| 401 |
' -------------------------------------------------------------- |
| 402 |
Select Case lngDataType |
| 403 |
Case REG_SZ: ' String data |
| 404 |
strKeyValue = Trim(varRegData) & Chr(0) ' null terminated |
| 405 |
m_lngRetVal = RegSetValueEx(lngKeyHandle, strRegSubKey, 0&, lngDataType, _ |
| 406 |
ByVal strKeyValue, Len(strKeyValue)) |
| 407 |
|
| 408 |
Case REG_DWORD: ' numeric data |
| 409 |
lngKeyValue = CLng(varRegData) |
| 410 |
m_lngRetVal = RegSetValueEx(lngKeyHandle, strRegSubKey, 0&, lngDataType, _ |
| 411 |
lngKeyValue, 4&) ' 4& = 4-byte word (long integer) |
| 412 |
|
| 413 |
End Select |
| 414 |
|
| 415 |
' -------------------------------------------------------------- |
| 416 |
' Always close the handle in the registry. We do not want to |
| 417 |
' corrupt these files. |
| 418 |
' -------------------------------------------------------------- |
| 419 |
m_lngRetVal = RegCloseKey(lngKeyHandle) |
| 420 |
|
| 421 |
End Sub |
| 422 |
Public Function regCreate_A_Key(ByVal lngRootKey As Long, ByVal strRegKeyPath As String) |
| 423 |
|
| 424 |
' -------------------------------------------------------------- |
| 425 |
' Written by Kenneth Ives kenaso@home.com |
| 426 |
' |
| 427 |
' Important: If you treat all key data strings as being |
| 428 |
' case sensitive, you should never have a problem. |
| 429 |
' Always backup your registry files (System.dat |
| 430 |
' and User.dat) before performing any type of |
| 431 |
' modifications |
| 432 |
' |
| 433 |
' Description: This function will create a new key |
| 434 |
' |
| 435 |
' Parameters: |
| 436 |
' lngRootKey - HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, |
| 437 |
' HKEY_lOCAL_MACHINE, HKEY_USERS, etc |
| 438 |
' strRegKeyPath - is name of the key you wish to create. |
| 439 |
' to make sub keys, continue to make this |
| 440 |
' call with each new level. MS says you |
| 441 |
' can do this in one call; however, the |
| 442 |
' best laid plans of mice and men ... |
| 443 |
' |
| 444 |
' Syntax: |
| 445 |
' regCreate_A_Key HKEY_CURRENT_USER, "Software\AAA-Registry Test" |
| 446 |
' regCreate_A_Key HKEY_CURRENT_USER, "Software\AAA-Registry Test\Products" |
| 447 |
' -------------------------------------------------------------- |
| 448 |
|
| 449 |
' -------------------------------------------------------------- |
| 450 |
' Define variables |
| 451 |
' -------------------------------------------------------------- |
| 452 |
Dim lngKeyHandle As Long |
| 453 |
|
| 454 |
' -------------------------------------------------------------- |
| 455 |
' Create the key. If it already exist, ignore it. |
| 456 |
' -------------------------------------------------------------- |
| 457 |
m_lngRetVal = RegCreateKey(lngRootKey, strRegKeyPath, lngKeyHandle) |
| 458 |
|
| 459 |
' -------------------------------------------------------------- |
| 460 |
' Always close the handle in the registry. We do not want to |
| 461 |
' corrupt these files. |
| 462 |
' -------------------------------------------------------------- |
| 463 |
m_lngRetVal = RegCloseKey(lngKeyHandle) |
| 464 |
|
| 465 |
End Function |
| 466 |
Public Function regDelete_A_Key(ByVal lngRootKey As Long, _ |
| 467 |
ByVal strRegKeyPath As String, _ |
| 468 |
ByVal strRegKeyName As String) As Boolean |
| 469 |
|
| 470 |
' -------------------------------------------------------------- |
| 471 |
' Written by Kenneth Ives kenaso@home.com |
| 472 |
' |
| 473 |
' Important: If you treat all key data strings as being |
| 474 |
' case sensitive, you should never have a problem. |
| 475 |
' Always backup your registry files (System.dat |
| 476 |
' and User.dat) before performing any type of |
| 477 |
' modifications |
| 478 |
' |
| 479 |
' Description: Function for removing a complete key. |
| 480 |
' |
| 481 |
' Parameters: |
| 482 |
' lngRootKey - HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, |
| 483 |
' HKEY_lOCAL_MACHINE, HKEY_USERS, etc |
| 484 |
' strRegKeyPath - is name of the key path you wish to traverse. |
| 485 |
' strRegKeyValue - is the name of the key which will be removed. |
| 486 |
' |
| 487 |
' Returns a True or False on completion. |
| 488 |
' |
| 489 |
' Syntax: |
| 490 |
' regDelete_A_Key HKEY_CURRENT_USER, "Software", "AAA-Registry Test" |
| 491 |
' |
| 492 |
' Removes the key "AAA-Registry Test" and all of its sub keys. |
| 493 |
' -------------------------------------------------------------- |
| 494 |
|
| 495 |
' -------------------------------------------------------------- |
| 496 |
' Define variables |
| 497 |
' -------------------------------------------------------------- |
| 498 |
Dim lngKeyHandle As Long |
| 499 |
|
| 500 |
' -------------------------------------------------------------- |
| 501 |
' Preset to a failed delete |
| 502 |
' -------------------------------------------------------------- |
| 503 |
regDelete_A_Key = False |
| 504 |
|
| 505 |
' -------------------------------------------------------------- |
| 506 |
' Make sure the key exist before trying to delete it |
| 507 |
' -------------------------------------------------------------- |
| 508 |
If regDoes_Key_Exist(lngRootKey, strRegKeyPath) Then |
| 509 |
|
| 510 |
' Get the key handle |
| 511 |
m_lngRetVal = RegOpenKey(lngRootKey, strRegKeyPath, lngKeyHandle) |
| 512 |
|
| 513 |
' Delete the key |
| 514 |
m_lngRetVal = RegDeleteKey(lngKeyHandle, strRegKeyName) |
| 515 |
|
| 516 |
' If the value returned is equal zero then we have succeeded |
| 517 |
If m_lngRetVal = 0 Then regDelete_A_Key = True |
| 518 |
|
| 519 |
' Always close the handle in the registry. We do not want to |
| 520 |
' corrupt the registry. |
| 521 |
m_lngRetVal = RegCloseKey(lngKeyHandle) |
| 522 |
End If |
| 523 |
|
| 524 |
End Function |
| 525 |
|
| 526 |
Sub Test() |
| 527 |
|
| 528 |
' -------------------------------------------------------------- |
| 529 |
' Test Windows registry basic functions. |
| 530 |
' Written by Kenneth Ives kenaso@home.com |
| 531 |
' |
| 532 |
' Rename this to "Main". Press F8 to step thru the code. You |
| 533 |
' will be able to stop at will and execute Regedit.exe to see |
| 534 |
' the results. Or, you can press F5 and this test procedure |
| 535 |
' has its own stops built in. |
| 536 |
' |
| 537 |
' Perform the four basic functions on the Windows registry. |
| 538 |
' Add |
| 539 |
' Change |
| 540 |
' Delete |
| 541 |
' Query |
| 542 |
' |
| 543 |
' Important: If you treat all key data strings as being |
| 544 |
' case sensitive, you should never have a problem. |
| 545 |
' Always backup your registry (System.dat and |
| 546 |
' User.dat) before performing any type of updates. |
| 547 |
' |
| 548 |
' Rename this procedure back to TEST so as not to intefere if |
| 549 |
' this BAS module is used in another application. |
| 550 |
' -------------------------------------------------------------- |
| 551 |
|
| 552 |
' -------------------------------------------------------------- |
| 553 |
' Define variables |
| 554 |
' -------------------------------------------------------------- |
| 555 |
Dim lngRootKey As Long |
| 556 |
Dim strKeyQuery As Variant ' we are not sure what type of |
| 557 |
' data will be returned |
| 558 |
|
| 559 |
' -------------------------------------------------------------- |
| 560 |
' Initialize variables |
| 561 |
' -------------------------------------------------------------- |
| 562 |
strKeyQuery = vbNullString |
| 563 |
lngRootKey = HKEY_CURRENT_USER |
| 564 |
|
| 565 |
' -------------------------------------------------------------- |
| 566 |
' See if the key already exist. If the key does not exist, we |
| 567 |
' will create one. Some people want to automatically create a |
| 568 |
' key if it does not exist. This philosophy can be dangerous. |
| 569 |
' Querying the registry is one function and updating is another. |
| 570 |
' -------------------------------------------------------------- |
| 571 |
If Not regDoes_Key_Exist(lngRootKey, "Software\AAA-Registry Test") Then |
| 572 |
' create the main key and the first sub key |
| 573 |
regCreate_A_Key lngRootKey, "Software\AAA-Registry Test" |
| 574 |
regCreate_A_Key lngRootKey, "Software\AAA-Registry Test\Products" |
| 575 |
End If |
| 576 |
|
| 577 |
' -------------------------------------------------------------- |
| 578 |
' see if the next sub key exist. |
| 579 |
' -------------------------------------------------------------- |
| 580 |
If Not regDoes_Key_Exist(lngRootKey, "Software\AAA-Registry Test\Products") Then |
| 581 |
' create the first sub key |
| 582 |
regCreate_A_Key lngRootKey, "Software\AAA-Registry Test\Products" |
| 583 |
End If |
| 584 |
|
| 585 |
' -------------------------------------------------------------- |
| 586 |
' Create a string type sub key |
| 587 |
' -------------------------------------------------------------- |
| 588 |
regCreate_Key_Value lngRootKey, "Software\AAA-Registry Test\Products", _ |
| 589 |
"StringTestData", "22 SEP 1999" |
| 590 |
|
| 591 |
' -------------------------------------------------------------- |
| 592 |
' Create a numeric type sub key |
| 593 |
' -------------------------------------------------------------- |
| 594 |
regCreate_Key_Value lngRootKey, "Software\AAA-Registry Test\Products", _ |
| 595 |
"NumericTestData", 1234567890 |
| 596 |
|
| 597 |
' -------------------------------------------------------------- |
| 598 |
' See if we have successfully created the key. The value of |
| 599 |
' of the sub key will be returned. strKeyQuery is a variant |
| 600 |
' because we do not know if the data being returned is string |
| 601 |
' or numeric. Once it is returned then we can manipulate it. |
| 602 |
' -------------------------------------------------------------- |
| 603 |
strKeyQuery = regQuery_A_Key(lngRootKey, "Software\AAA-Registry Test\Products", "StringTestData") |
| 604 |
strKeyQuery = regQuery_A_Key(lngRootKey, "Software\AAA-Registry Test\Products", "NumericTestData") |
| 605 |
|
| 606 |
' -------------------------------------------------------------- |
| 607 |
' Stop processing here. |
| 608 |
' Execute Regedit.exe and verify that all the keys have |
| 609 |
' been added to the registry. |
| 610 |
' Press F5 or F8 to continue. |
| 611 |
' -------------------------------------------------------------- |
| 612 |
Stop |
| 613 |
|
| 614 |
' -------------------------------------------------------------- |
| 615 |
' Change the value of the sub key, "StringTestData", from |
| 616 |
' "22 SEP 1999" to "September 22, 1999" |
| 617 |
' -------------------------------------------------------------- |
| 618 |
regCreate_Key_Value lngRootKey, "Software\AAA-Registry Test\Products", _ |
| 619 |
"StringTestData", "September 22, 1999" |
| 620 |
|
| 621 |
' -------------------------------------------------------------- |
| 622 |
' See if the sub key has been updated |
| 623 |
' -------------------------------------------------------------- |
| 624 |
strKeyQuery = regQuery_A_Key(lngRootKey, "Software\AAA-Registry Test\Products", "StringTestData") |
| 625 |
|
| 626 |
' -------------------------------------------------------------- |
| 627 |
' Stop processing here. |
| 628 |
' Execute Regedit.exe and verify that the sub key has |
| 629 |
' been updated in the registry. |
| 630 |
' Press F5 or F8 to continue. |
| 631 |
' -------------------------------------------------------------- |
| 632 |
Stop |
| 633 |
|
| 634 |
' -------------------------------------------------------------- |
| 635 |
' Delete the sub key, "NumericTestData", only. |
| 636 |
' -------------------------------------------------------------- |
| 637 |
regDelete_Sub_Key lngRootKey, "Software\AAA-Registry Test\Products", "NumericTestData" |
| 638 |
|
| 639 |
' -------------------------------------------------------------- |
| 640 |
' Stop processing here. |
| 641 |
' Execute Regedit.exe and verify the sub key ("NumericTestData") |
| 642 |
' has been removed from the registry. |
| 643 |
' Press F5 or F8 to continue. |
| 644 |
' -------------------------------------------------------------- |
| 645 |
Stop |
| 646 |
|
| 647 |
' -------------------------------------------------------------- |
| 648 |
' Remove the complete key from the registry. You do not want |
| 649 |
' to remove the "Software" key. NT users must remove each |
| 650 |
' major key component separately as shown below. Windows 95/98 |
| 651 |
' users can do this in one step by using the second line only. |
| 652 |
' -------------------------------------------------------------- |
| 653 |
If Not regDelete_A_Key(lngRootKey, "Software\AAA-Registry Test", "Products") Then |
| 654 |
MsgBox "Failed to delete requested subkey! ", vbOKOnly + vbExclamation, "Registry Key Delete" |
| 655 |
GoTo Normal_Exit: |
| 656 |
End If |
| 657 |
|
| 658 |
If Not regDelete_A_Key(lngRootKey, "Software", "AAA-Registry Test") Then |
| 659 |
MsgBox "Failed to delete requested main key! ", vbOKOnly + vbExclamation, "Registry Key Delete" |
| 660 |
GoTo Normal_Exit: |
| 661 |
End If |
| 662 |
|
| 663 |
|
| 664 |
Normal_Exit: |
| 665 |
' -------------------------------------------------------------- |
| 666 |
' Terminate program. |
| 667 |
' Execute Regedit.exe and verify that the key |
| 668 |
' ("AAA-Registry Test") and all of its sub keys have been |
| 669 |
' removed from the registry. |
| 670 |
' -------------------------------------------------------------- |
| 671 |
End |
| 672 |
|
| 673 |
End Sub |