home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD53124282000.psc / modReg.bas < prev    next >
Encoding:
BASIC Source File  |  2000-04-26  |  2.3 KB  |  68 lines
  1. Attribute VB_Name = "modReg"
  2. '//This code saves and reads registry keys using the
  3. '//main registry NOT VB & VBA programs
  4. '//Most of the code is mine but some is from other sources
  5. '//Again Sorry it isn't commented but I always copy and
  6. '//paste this module into my programs and I keep forgetting
  7. '//to comment it
  8.  
  9. Public Const HKEY_CURRENT_USER = &H80000001
  10.  
  11. Declare Function RegCloseKey Lib "advapi32.dll" _
  12. (ByVal Hkey As Long) As Long
  13.  
  14. Declare Function RegCreateKey Lib "advapi32.dll" Alias _
  15. "RegCreateKeyA" (ByVal Hkey As Long, ByVal lpSubKey As _
  16. String, phkResult As Long) As Long
  17.  
  18. Declare Function RegOpenKey Lib "advapi32.dll" Alias _
  19. "RegOpenKeyA" (ByVal Hkey As Long, ByVal lpSubKey As _
  20. String, phkResult As Long) As Long
  21.  
  22. Declare Function RegQueryValueEx Lib "advapi32.dll" _
  23. Alias "RegQueryValueExA" (ByVal Hkey As Long, ByVal _
  24. lpValueName As String, ByVal lpReserved As Long, lpType _
  25. As Long, lpData As Any, lpcbData As Long) As Long
  26.  
  27. Declare Function RegSetValueEx Lib "advapi32.dll" Alias _
  28. "RegSetValueExA" (ByVal Hkey As Long, ByVal lpValueName _
  29. As String, ByVal Reserved As Long, ByVal dwType As Long, _
  30. lpData As Any, ByVal cbData As Long) As Long
  31.  
  32. Public Const REG_SZ = 1
  33. Public Const REG_DWORD = 4
  34.  
  35.  
  36. Public Function GetString(Hkey As Long, strPath As String, strValue As String)
  37.  
  38. Dim keyhand As Long
  39. Dim datatype As Long
  40. Dim lResult As Long
  41. Dim strBuf As String
  42. Dim lDataBufSize As Long
  43. Dim intZeroPos As Integer
  44.     r = RegOpenKey(Hkey, strPath, keyhand)
  45.     lResult = RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&, lDataBufSize)
  46.     If lValueType = REG_SZ Then
  47.         strBuf = String(lDataBufSize, " ")
  48.         lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, ByVal strBuf, lDataBufSize)
  49.         If lResult = ERROR_SUCCESS Then
  50.             intZeroPos = InStr(strBuf, Chr$(0))
  51.             If intZeroPos > 0 Then
  52.                 GetString = Left$(strBuf, intZeroPos - 1)
  53.             Else
  54.                 GetString = strBuf
  55.             End If
  56.         End If
  57.     End If
  58. End Function
  59.  
  60. Public Sub SaveString(Hkey As Long, strPath As String, strValue As String, strdata As String)
  61. Dim keyhand As Long
  62. Dim r As Long
  63.     r = RegCreateKey(Hkey, strPath, keyhand)
  64.     r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))
  65.     r = RegCloseKey(keyhand)
  66. End Sub
  67.  
  68.