VB注册表操作函数

  1. Option Explicit
  2. '
  3. '注册表操作(SmRegCtr)
  4. '
  5. '/类型.
  6. Public Enum RegDataType
  7.     '/REG_NONE = 0                     ' 未知类型
  8.     REG_SZ = 1                         ' Unicode字符串
  9.     '/REG_EXPAND_SZ = 2                ' Unicode字符串
  10.     REG_BINARY = 3                     ' 二进制
  11.     '/REG_DWORD = 4                    ' 双字节型.
  12.     '/REG_DWORD_LITTLE_ENDIAN = 4      ' 32-bit number (same as REG_DWORD)
  13.     '/REG_DWORD_BIG_ENDIAN = 5         ' 32-bit number
  14. End Enum
  15. Public Enum RegMainKey
  16.     HKEY_CLASSES_ROOT = 
  17.     HKEY_CURRENT_USER = 
  18.     HKEY_LOCAL_MACHINE = 
  19.     HKEY_USERS = 
  20.     HKEY_PERFORMANCE_DATA = 
  21.     HKEY_CURRENT_CONFIG = 
  22.     HKEY_DYN_DATA = 
  23. End Enum
  24. '
  25. Const READ_CONTROL = 
  26. Const STANDARD_RIGHTS_READ = (READ_CONTROL)
  27. Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
  28. Const KEY_QUERY_VALUE = 
  29. Const KEY_SET_VALUE = 
  30. Const KEY_CREATE_SUB_KEY = 
  31. Const KEY_ENUMERATE_SUB_KEYS = 
  32. Const KEY_NOTIFY = 
  33. Const KEY_CREATE_LINK = 
  34. Const SYNCHRONIZE = 
  35. Const STANDARD_RIGHTS_ALL = 
  36. '----------------------------------------------------------------
  37. Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
  38.    KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) _
  39.    And (Not SYNCHRONIZE))
  40. Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or _
  41.    KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
  42. Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or _
  43.    KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY _
  44.    Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) _
  45.    And (Not SYNCHRONIZE))
  46. Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
  47. Const ERROR_SUCCESS = 0
  48. '-----------------------------------------------------------------
  49. Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As LongAs Long
  50. Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As LongByVal lpSubKey As StringAs Long
  51. Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As LongByVal lpSubKey As String, phkResult As LongAs Long
  52. Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As LongByVal lpValueName As StringAs Long
  53. Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As LongByVal lpSubKey As String, phkResult As LongAs Long
  54. Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As LongByVal lpValueName As StringByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As LongAs Long
  55. Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As LongByVal lpValueName As StringByVal Reserved As LongByVal dwType As Long, lpData As Any, ByVal cbData As LongAs Long
  56. Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As LongByVal dwIndex As LongByVal lpName As String, lpcbName As LongByVal lpReserved As LongByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As Any) As Long
  57. Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As LongByVal dwIndex As LongByVal lpValueName As String, lpcbValueName As LongByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As LongAs Long
  58. '
  59. '功能:取某键值下的所有项
  60. '函数:RegEnumKeyVal
  61. '参数:hKey RegMainKey枚举,subKey 子键路径名称.
  62. '返回值:String 字符串数组
  63. '例子:
  64. Public Function RegEnumKeyVal(hKey As RegMainKey, subKey As StringAs String()
  65.     Dim mhKey As Long, Cnt As Long, sSave As String
  66.     Dim RevVal() As String
  67.     
  68.     On Error Resume Next
  69.     
  70.     RegOpenKey hKey, "Enum", mhKey
  71.     Do
  72.         sSave = String(255, 0)
  73.         If RegEnumKeyEx(mhKey, Cnt, sSave, 255, 0, vbNullString, ByVal 0&, ByVal 0&) <> 0 Then Exit Do
  74.         Cnt = Cnt + 1
  75.     Loop
  76.     RegCloseKey mhKey
  77.     RegOpenKey hKey, subKey, mhKey
  78.     Cnt = 0
  79.     Do
  80.         sSave = String(255, 0)
  81.         If RegEnumValue(mhKey, Cnt, sSave, 255, 0, ByVal 0&, ByVal 0&, ByVal 0&) <> 0 Then Exit Do
  82.         Cnt = Cnt + 1
  83.         ReDim Preserve RevVal(Cnt - 1)
  84.         RevVal(Cnt - 1) = StripTerminator(sSave)
  85.     Loop
  86.     RegCloseKey hKey
  87.     RegEnumKeyVal = RevVal
  88. End Function
  89.     
  90. '
  91. '功能:建立子键.
  92. '函数:RegCreatesubKey
  93. '参数:hKey RegMainKey枚举,subKey 子键名称.
  94. '返回值:0 成功,其它值 失败.
  95. '例子:
  96. Public Function RegCreatesubKey(hKey As RegMainKey, subKey As StringAs Variant
  97.        Dim Ret As Variant
  98.        If Left$(subKey, 1) = "/" Then subKey = Right$(subKey, Len(subKey) - 1)
  99.        If Right$(subKey, 1) = "/" Then subKey = Left$(subKey, Len(subKey) - 1)
  100.        RegCreateKey hKey, subKey, Ret
  101.        RegCreatesubKey = Ret
  102. End Function
  103. '
  104. '功能:删除子键.
  105. '函数:RegDeletesubKey
  106. '参数:hKey RegMainKey枚举,subKey 子键名称.
  107. '返回值:无
  108. '例子:
  109. Public Function RegDeletesubKey(hKey As RegMainKey, subKey As String)
  110.        If Left$(subKey, 1) = "/" Then subKey = Right$(subKey, Len(subKey) - 1)
  111.        If Right$(subKey, 1) = "/" Then subKey = Left$(subKey, Len(subKey) - 1)
  112.        RegDeleteKey hKey, subKey
  113. End Function
  114. '
  115. '功能:保存值到注册表.
  116. '函数:RegSaveData
  117. '参数:hKey RegMainKey枚举,subKey 子键名称.ValName 值名称,KeyVal 值,ValType RegDataType枚举.
  118. '返回值:0 成功,其它值 失败.
  119. '例子:
  120. Public Function RegSaveData(hKey As RegMainKey, subKey As String, ValName As String, KeyVal As StringOptional ValType As RegDataType = REG_SZ) As Long
  121.     Dim Ret As Long
  122.     On Error Resume Next
  123.     Ret = 0
  124.     If Left$(subKey, 1) = "/" Then subKey = Right$(subKey, Len(subKey) - 1)
  125.     If Right$(subKey, 1) = "/" Then subKey = Left$(subKey, Len(subKey) - 1)
  126.     If ValType = RegDataType.REG_BINARY Then
  127.        Ret = SaveStringLong(hKey, subKey, ValName, KeyVal)
  128.     Else
  129.        Ret = SaveString(hKey, subKey, ValName, KeyVal)
  130.     End If
  131.     RegSaveData = Ret
  132. End Function
  133. '
  134. '功能:取注册表中的值.
  135. '函数:RegGetVal
  136. '参数:hKey RegMainKey枚举,subKey 子键名称.ValName 值名称
  137. '返回值:成功,返回注册表中的值,失败 NULL
  138. '例子:
  139. Public Function RegGetVal(hKey As RegMainKey, subKey As String, ValName As StringAs Variant
  140.     Dim Ret As Variant
  141.     If Left$(subKey, 1) = "/" Then subKey = Right$(subKey, Len(subKey) - 1)
  142.     If Right$(subKey, 1) = "/" Then subKey = Left$(subKey, Len(subKey) - 1)
  143.     Ret = GetString(hKey, subKey, ValName)
  144.     RegGetVal = Ret
  145. End Function
  146. '
  147. '功能:删除注册表中的值.
  148. '函数:RegDelVal
  149. '参数:hKey RegMainKey枚举,subKey 子键名称.ValName 值名称
  150. '返回值:成功,返回注册表中的值,失败 NULL
  151. '例子:
  152. Public Function RegDelVal(hKey As RegMainKey, subKey As String, ValName As String)
  153.        DelSetting hKey, subKey, ValName
  154. End Function
  155. '/===================================================================================
  156. '/以下函数为功能函数.
  157. '/取注册表中的值.
  158. Function GetString(hKey As RegMainKey, subKey As String, ValName As StringAs Variant
  159.     On Error Resume Next
  160.     Dim Ret As Variant
  161.     RegOpenKey hKey, subKey, Ret
  162.     GetString = RegQueryStringValue(Ret, ValName)
  163.     RegCloseKey Ret
  164. End Function
  165. '/保存字符串.
  166. Function SaveString(hKey As RegMainKey, subKey As String, ValName As String, strData As String)
  167.     Dim Ret As Variant
  168.     Dim ReturnVal As Long
  169.     On Error Resume Next
  170.     RegCreateKey hKey, subKey, Ret
  171.     ReturnVal = RegSetValueEx(Ret, ValName, 0, RegDataType.REG_SZ, ByVal strData, Len(strData))
  172.     RegCloseKey Ret
  173. End Function
  174. '/保存值二进制值.
  175. Function SaveStringLong(hKey As RegMainKey, subKey As String, ValName As String, strData As StringAs Variant
  176.     Dim Ret As Variant
  177.     On Error Resume Next
  178.     RegCreateKey hKey, subKey, Ret
  179.     RegSetValueEx Ret, ValName, 0, RegDataType.REG_BINARY, CByte(strData), 1
  180.     RegCloseKey Ret
  181. End Function
  182. '/删除值
  183. Function DelSetting(hKey As RegMainKey, subKey As String, ValName As String)
  184.     Dim Ret As Variant
  185.     On Error Resume Next
  186.     RegCreateKey hKey, subKey, Ret
  187.     RegDeleteValue Ret, ValName
  188.     RegCloseKey Ret
  189. End Function
  190. Function RegQueryStringValue(ByVal hKey As RegMainKey, ByVal ValName As StringAs String
  191.     Dim lResult As Long
  192.     Dim lValueType As Long
  193.     Dim strBuf As String
  194.     Dim lDataBufSize As Long
  195.     Dim strData As Long
  196.     Dim RetVal As String
  197.     
  198.     On Error Resume Next
  199.     
  200.     lResult = RegQueryValueEx(hKey, ValName, 0, lValueType, ByVal 0, lDataBufSize)
  201.     If lResult = 0 Then
  202.         If lValueType = RegDataType.REG_SZ Then
  203.             strBuf = String(lDataBufSize, Chr$(0))
  204.             lResult = RegQueryValueEx(hKey, ValName, 0, 0, ByVal strBuf, lDataBufSize)
  205.             If lResult = 0 Then
  206.                RetVal = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
  207.             End If
  208.         ElseIf lValueType = RegDataType.REG_BINARY Then
  209.             lResult = RegQueryValueEx(hKey, ValName, 0, 0, strData, lDataBufSize)
  210.             If lResult = 0 Then
  211.                RetVal = strData
  212.             End If
  213.         End If
  214.     End If
  215.     RegQueryStringValue = RetVal
  216. End Function
  217. Private Function StripTerminator(sInput As StringAs String
  218.     Dim ZeroPos As Integer
  219.     ZeroPos = InStr(1, sInput, vbNullChar)
  220.     If ZeroPos > 0 Then
  221.         StripTerminator = Left$(sInput, ZeroPos - 1)
  222.     Else
  223.         StripTerminator = sInput
  224.     End If
  225. End Function
 
发布了25 篇原创文章 · 获赞 4 · 访问量 6万+
展开阅读全文

没有更多推荐了,返回首页

©️2019 CSDN 皮肤主题: 大白 设计师: CSDN官方博客

分享到微信朋友圈

×

扫一扫,手机浏览