VB如何在Win10X64位系统上进行读写64位的注册表

win10X64位系统注册表分两个部分：64位和32位，当我们用VB6生成的exe可执行的程序后，进行操作注册表时发现某些项无法写入和读取，这是因为VB6生成的程序是32位的，可见用32位的程序去读写64位的注册表是不可行的，执行命令会被64位注册表自动重定向，也就是当我们用32位的程序去操作64位的注册表时，会被注册表自动重定向到32位的注册表项。
要解决这一问题，我们需要分两部分操作：
第一点就是将自己32位的程序设置与系统兼容，这个可以在exe文件图标右键打开属性，点击选项卡中的"兼容性"，将兼容模式设为XP或更高版本的系统，再在下面点选"以管理员身份运行此程序"，确定即可。但有人就会问能不能用代码在程序启动前设置这两个属性值呢？能，因为这两个设置也是存在注册表里的，那么我们通过Windows强大的API便可完成这一步操作；
第二点就是重定向64位注册表读写。
‘
解决第一点我们用到四个API函数：RegCreateKey，RegQueryValueEx，RegSetValueEx，RegCloseKey

• RegCreateKey 声明
• Private Declare Function RegCreateKey Lib “advapi32.dll” Alias “RegCreateKeyA” (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
  *说明： 在指定的项下创建一个新项。如指定的项已经存在，那么函数会打开现有的项
• 返回值：Long，零（ERROR_SUCCESS）表示成功。其他任何值都代表一个错误代码
• 参数：
• hKey ----------- Long，要打开项的句柄，或者一个标准项名
  lpSubKey ------- String，欲创建的新子项。可同时创建多个项，只需用反斜杠将它们分隔开即可。例如level1\level2\newkey
  phkResult ------ Long，指定一个变量，用于装载新子项的句柄
  ’
  *RegQueryValueEx 声明
  *Private Declare Function RegQueryValueEx Lib “advapi32.dll” Alias “RegQueryValueExA” (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByRef lpData As Any, ByRef lpcbData As Long) As Long
  *说明：获取一个项的设置值
  *返回值：Long，零（ERROR_SUCCESS）表示成功。其他任何值都代表一个错误代码
  *参数：hKey ----------- Long，一个已打开项的句柄，或者指定一个标准项名
  lpValueName ---- String，要获取值的名字
  lpReserved ----- Long，未用，设为零
  lpType --------- Long，用于装载取回数据类型的一个变量
  lpData --------- Any，用于装载指定值的一个缓冲区
  lpcbData ------- Long，用于装载lpData缓冲区长度的一个变量。一旦返回，它会设为实际装载到缓冲区的字节数
  ‘
  *RegSetValueEx 声明
  *Private Declare Function RegSetValueEx Lib “advapi32” Alias “RegSetValueExA” (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
  *说明：设置指定项的值
  *返回值：Long，零（ERROR_SUCCESS）表示成功。其他任何值都代表一个错误代码
  *参数：hKey ----------- Long，一个已打开项的句柄，或指定一个标准项名
  lpValueName ---- String，要设置值的名字
  Reserved ------- Long，未用，设为零
  dwType --------- Long，要设置的数量类型
  lpData --------- Any，包含数据的缓冲区中的第一个字节
  cbData --------- Long，lpData缓冲区的长度
  ’
  *RegCloseKey 声明
  *Private Declare Function RegCloseKey Lib “advapi32.dll” Alias “RegCloseKey” (ByVal hKey As Long) As Long
  *说明：关闭系统注册表中的一个项（或键）
  *返回值：Long，零（ERROR_SUCCESS）表示成功。其他任何值都代表一个错误代码
  *参数：hKey ----------- Long，要关闭的项
  ’
  ‘-------------------------------------------------------------------------------------------------------------------------------------------
  ‘为了方便调用，这里将以上四个API函数写成一个集函数，函数代码如下：
  '函数返回值=(注册表根键，项位置，子健名称，子健值)
  Function SetSafe(RootType As String,Position As String,KeyName As String, KeyValue As String)
  Dim Rkey As Long’获得句柄
  Dim Goback as Long’返回的值
  Dim REG_SZ As Long’子健类型
  ’打开注册表项的句柄(实例化)，没有就创建一个新项
  Goback = RegCreateKey(RootType,Position, Rkey)
  '判断(读取)子健是否存在
  Goback= RegQueryValueEx(Rkey KeyName, 0, REG_SZ, KeyValue, Len(KeyValue))
  If Goback=2 then’子健不存在时就写入子健和值
  Goback= RegSetValueEx(Rkey, KeyName, 0, REG_SZ, KeyValue, Len(KeyValue))
  End If
  Call RegCloseKey(Rkey) '关闭该键
  End Function

*调用：
文件兼容模式属性设置在注册表位置：“HKEY_CURRENT_USER, SOFTWARE\Microsoft\Windows NT\CurrentVersion\AppCompatFlags\Layers”
’
'VB6调用以上函数写入注册表代码如下：
Call SetSafe(“HKEY_CURRENT_USER”,“SOFTWARE\Microsoft\Windows NT\CurrentVersion\AppCompatFlags\Layers”,App.Path & “” & App.EXEName & “.exe”, “~ RUNASADMIN WINXPSP2”)
’
'到处，我们就通过注册表设置了程序的兼容模式。
’
'接下来就是解决重定向64位注册表的读写，用到的API在此小编就不多解释其参数了，直接上代码。
’读写64位注册表的代码：
Option Explicit
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Public Enum CHILDREN '子健数据类型
[REG_SZ] = 1 ’ Unicode空终结字符串
[REG_BINARY] = 3 '二进制值
[REG_DWORD] = 4 ’ 32位值
[REG_QWORD] = 11 '64位值
[REG_MULTI_SZ] = 7 '多字符串值
[REG_EXPAND_SZ] = 2 '可扩充字符串值
End Enum
Public Enum RKRT_REYROOT '注册表关键字根类型
[HKEY_CLASSES_ROOT] = &H80000000
[HKEY_CURRENT_USER] = &H80000001
[HKEY_LOCAL_MACHINE] = &H80000002
[HKEY_USERS] = &H80000003
[HKEY_PERFORMANCE_DATA] = &H80000004
End Enum
Private Declare Sub Sleep Lib “kernel32” (ByVal dwMilliseconds As Long)
'- - - - - - - - - - - - - - - 获取系统为32位或64位系统API - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Private Declare Function LoadLibrary Lib “kernel32.dll” Alias “LoadLibraryA” (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib “kernel32.dll” (ByVal hLibModule As Long) As Long
Private Declare Function GetProcAddress Lib “kernel32.dll” (ByVal hModule As Long, ByVal lpProcName As String) As Long
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Exit
'- - - - - - - - - - - - - - - 读写注册表API - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Private Declare Function RegCreateKeyEx Lib “advapi32” 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, ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, ByRef phkResult As Long, ByRef lpdwDisposition As Long) As Long
Private Declare Function RegSetValueEx Lib “advapi32” Alias “RegSetValueExA” (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Function RegDeleteKey Lib “advapi32.dll” Alias “RegDeleteKeyA” (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function SHDeleteKey Lib “shlwapi.dll” Alias “SHDeleteKeyA” (ByVal hKey As Long, ByVal pszSubKey As String) As Long
Private Declare Function RegDeleteValue Lib “advapi32.dll” Alias “RegDeleteValueA” (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegCloseKey Lib “advapi32” (ByVal hKey As Long) As Long
Private Declare Function RegEnumValue Lib “advapi32.dll” Alias “RegEnumValueA” (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
Private Declare Function RegQueryValueEx Lib “advapi32.dll” Alias “RegQueryValueExA” (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByRef lpData As Any, ByRef lpcbData As Long) As Long
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Exit

Private Const KEY_WOW64_64KEY = &H100& '64位系统注册表
Private Const KEY_WOW64_32KEY = &H200& '32位系统注册表

'操作注册表(关键字根类型，项位置，子键(项)名称，子键的值,子键类型，处理事件[0:创建一个项，1:创建一个子键，2:删除一个子健，3:删除一个项(包括项下所有子项和子健)]，计算机处理器[缺省为自动识别，1为32位，2位64位])
Public Function Registry(ByVal RootType As RKRT_REYROOT, ByVal Position As String, ByVal SubKeyName As String, ByVal SubKeyValue As String, ByVal SubKeyType As CHILDREN, ByVal SubkeyEvent As Long, Optional Bit As Long = 0) As String
'返回,处理一个注册表关键字
Dim Goback As Long, Rkey As Long, SafetyType As SECURITY_ATTRIBUTES, Unknown As Long, WinBit As Long
Dim sSave As String, Cnt As Integer
'WinBit=系统处理器,Bit参数：0缺省为自动识别，1为32位系统，2为64位系统
WinBit = IIf(Bit <= 0, IIf(IsSupport, KEY_WOW64_64KEY, KEY_WOW64_32KEY), IIf(Bit > 1, KEY_WOW64_64KEY, KEY_WOW64_32KEY))
SafetyType.bInheritHandle = True: SafetyType.lpSecurityDescriptor = 0: SafetyType.nLength = 50 '设置安全属性为缺省值
'打开一个项，如果不存在便创建
Goback = RegCreateKeyEx(RootType, IIf(SubkeyEvent > 0, Position, Position & “” & SubKeyName), 0&, 1&, 0&, WinBit, SafetyType, Rkey, Unknown)
If SubkeyEvent = 0 Then Exit Function '只创建项，拦截以下过程
Select Case SubkeyEvent
Case 1 ’ 创建/修改关键字值
Goback = RegSetValueEx(Rkey, SubKeyName, 0, SubKeyType, SubKeyValue, LenB(StrConv(SubKeyValue, vbFromUnicode)))
Case 2 '删除子健
Goback = RegDeleteValue(Rkey, SubKeyName)
Case 3 '删除最后一个项及子健
Goback = RegDeleteKey(Rkey, SubKeyName)
Case 4 '删除主项及主项下子项(包括子项下的子健值)
Goback = SHDeleteKey(Rkey, SubKeyName)
Case 5 '判断指定的子健是否存在
Goback = RegQueryValueEx(Rkey, SubKeyName, 0, 0, 0, 0)
Registry = CBool(IIf(Goback = 2, 0, 1)): Call RegCloseKey(Rkey): Exit Function
Case 6 '获取子健值(非批量)
sSave = String(255, Chr(0))
Goback = RegQueryValueEx(Rkey, SubKeyName, 0, 1, ByVal sSave, Len(sSave))
Registry = sSave: Call RegCloseKey(Rkey): Exit Function
Case 7 '获取指定一个项下所有子健名称
Cnt = 0
Do
sSave = String(255, 0)
If RegEnumValue(Rkey, Cnt, sSave, 255, 0, ByVal 0&, ByVal 0&, ByVal 0&) <> 0 Then Exit Do
List1.AddItem StripTerminator(sSave)
Cnt = Cnt + 1
Loop
End Select
Registry = CBool(IIf(Goback, 0, 1)) '函数返回结果
Call RestartExplorer
Goback = RegCloseKey(Rkey) ’ 关闭关键字
End Function

'判断系统为32位还是64位(True：64位，False：32位)
Private Function IsSupport() As Boolean
Dim Dhwnh As Long, Site As Long
Dhwnh = LoadLibrary(“Kernel32”) '映像模块到进行地址空间
If Dhwnh Then
Site = GetProcAddress(Dhwnh, “Wow64DisableWow64FsRedirection”) '返回函数地址
FreeLibrary Dhwnh '卸载库模块
IsSupport = IIf(Site, True, False)
End If
End Function

'此函数用于去掉所有不必要的 Chr$(0)中止符PublicFunctionStripTerminator(sInputAsString)AsStringDimZeroPosAsIntege{r}^{\prime }搜索第一个Chr$(0) 中止符
ZeroPos = InStr(1, sInput, vbNullChar)
If ZeroPos > 0 Then
StripTerminator = Left$(sInput, ZeroPos - 1)
Else
StripTerminator = sInput
End If
End Function
’
’
’
'调用 Registry 函数进行读写注册表，按函数操作执行即可，希望对大家有用！