"C:\Program Files\Microsoft Visual Studio\VB98\Template\Code\注册表访问.bas"
解决方案 »
- 急!!!!截取数据库(access)其中一部分来用,看看我的这个哪里有问题啊
- WebBrowser的silent设置成true以后在调试或编译的时候自动改成flase是什么问题??
- 冰天血地赤身裸体后空翻720度跪求
- 有没有直接装上就是sp6的安装盘???
- 请问!DBGRID32.OCX不能注册?如何解决?
- 有关msflexgrid 的提问
- 各位四爷,小的有事请教各位。
- 请问哪里有比较好的activex表格控件?
- 100分呀,还有挑战性,一个有点难度的问题,再网格控间上如何添加事件!!!
- 如何取得指定目录下所有文件的文件名(包括所有下一级子目录中的),和所有的子目录名?
- 从电子称到com口怎么知道某一次的传输已经结束?急急急
- webBrowser的几个使用问题
Option ExplicitGlobal Const REG_SZ As Long = 1
Global Const REG_DWORD As Long = 4Global Const HKEY_CLASSES_ROOT = &H80000000
Global Const HKEY_CURRENT_USER = &H80000001
Global Const HKEY_LOCAL_MACHINE = &H80000002
Global Const HKEY_USERS = &H80000003Global Const ERROR_NONE = 0
Global Const ERROR_BADDB = 1
Global Const ERROR_BADKEY = 2
Global Const ERROR_CANTOPEN = 3
Global Const ERROR_CANTREAD = 4
Global Const ERROR_CANTWRITE = 5
Global Const ERROR_OUTOFMEMORY = 6
Global Const ERROR_INVALID_PARAMETER = 7
Global Const ERROR_ACCESS_DENIED = 8
Global Const ERROR_INVALID_PARAMETERS = 87
Global Const ERROR_NO_MORE_ITEMS = 259Global Const KEY_ALL_ACCESS = &H3FGlobal Const REG_OPTION_NON_VOLATILE = 0Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey 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, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition 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 RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData 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
Private Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String)
Private Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String)Public Function DeleteKey(lPredefinedKey As Long, sKeyName As String)
Dim lRetVal As Long
Dim hKey As Long
lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = RegDeleteKey(lPredefinedKey, sKeyName)
RegCloseKey (hKey)
End FunctionPublic Function DeleteValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)
Dim lRetVal As Long
Dim hKey As Long lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = RegDeleteValue(hKey, sValueName)
RegCloseKey (hKey)
End FunctionPublic Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
Dim lValue As Long
Dim sValue As String Select Case lType
Case REG_SZ
sValue = vValue
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
Case REG_DWORD
lValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
End SelectEnd FunctionFunction QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String On Error GoTo QueryValueExError lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
If lrc <> ERROR_NONE Then Error 5 Select Case lType
Case REG_SZ:
sValue = String(cch, 0)
lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
If lrc = ERROR_NONE Then
vValue = Left(sValue, cch - 1)
Else
vValue = Empty
End If Case REG_DWORD:
lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
If lrc = ERROR_NONE Then vValue = lValue
Case Else
lrc = -1
End SelectQueryValueExExit: QueryValueEx = lrc
Exit FunctionQueryValueExError: Resume QueryValueExExitEnd Function
Public Function CreateNewKey(lPredefinedKey As Long, sNewKeyName As String)
Dim hNewKey As Long
Dim lRetVal As Long
lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)
RegCloseKey (hNewKey)
End FunctionSub Main()
' 函数在注册表的"HKEY_CURRENT_USER\Software"中建立了
' 一个SubKey1项并在其中建立了值,并在显示后删除建立
' 的值,如果你想通过RegEdit看到结果,可以将最后两句
' 删除,不过要记得手动删除建立的键值
CreateNewKey HKEY_CURRENT_USER, "Software\SubKey1\SubKey2"
SetKeyValue HKEY_CURRENT_USER, "Software\SubKey1\SubKey2", "Test", "This is just a test", REG_SZ
MsgBox QueryValue(HKEY_CURRENT_USER, "Software\SubKey1\SubKey2", "Test")
DeleteValue HKEY_CURRENT_USER, "Software\SubKey1\SubKey2", "Test"
DeleteKey HKEY_CURRENT_USER, "Software\SubKey1\SubKey2"
End Sub
Public Function SetKeyValue(lPredefinedKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)
Dim lRetVal As Long
Dim hKey As Long lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
RegCloseKey (hKey)
End FunctionPublic Function QueryValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)
Dim lRetVal As Long
Dim hKey As Long
Dim vValue As Variant
lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = QueryValueEx(hKey, sValueName, vValue)
QueryValue = vValue
RegCloseKey (hKey)
End Function
Option ExplicitGlobal Const REG_SZ As Long = 1
Global Const REG_DWORD As Long = 4Global Const HKEY_CLASSES_ROOT = &H80000000
Global Const HKEY_CURRENT_USER = &H80000001
Global Const HKEY_LOCAL_MACHINE = &H80000002
Global Const HKEY_USERS = &H80000003Global Const ERROR_NONE = 0
Global Const ERROR_BADDB = 1
Global Const ERROR_BADKEY = 2
Global Const ERROR_CANTOPEN = 3
Global Const ERROR_CANTREAD = 4
Global Const ERROR_CANTWRITE = 5
Global Const ERROR_OUTOFMEMORY = 6
Global Const ERROR_INVALID_PARAMETER = 7
Global Const ERROR_ACCESS_DENIED = 8
Global Const ERROR_INVALID_PARAMETERS = 87
Global Const ERROR_NO_MORE_ITEMS = 259Global Const KEY_ALL_ACCESS = &H3FGlobal Const REG_OPTION_NON_VOLATILE = 0Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey 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, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition 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 RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData 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
Private Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String)
Private Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String)Public Function DeleteKey(lPredefinedKey As Long, sKeyName As String)
Dim lRetVal As Long
Dim hKey As Long
lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = RegDeleteKey(lPredefinedKey, sKeyName)
RegCloseKey (hKey)
End FunctionPublic Function DeleteValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)
Dim lRetVal As Long
Dim hKey As Long lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = RegDeleteValue(hKey, sValueName)
RegCloseKey (hKey)
End FunctionPublic Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
Dim lValue As Long
Dim sValue As String Select Case lType
Case REG_SZ
sValue = vValue
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
Case REG_DWORD
lValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
End SelectEnd FunctionFunction QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String On Error GoTo QueryValueExError lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
If lrc <> ERROR_NONE Then Error 5 Select Case lType
Case REG_SZ:
sValue = String(cch, 0)
lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
If lrc = ERROR_NONE Then
vValue = Left(sValue, cch - 1)
Else
vValue = Empty
End If Case REG_DWORD:
lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
If lrc = ERROR_NONE Then vValue = lValue
Case Else
lrc = -1
End SelectQueryValueExExit: QueryValueEx = lrc
Exit FunctionQueryValueExError: Resume QueryValueExExitEnd Function
Public Function CreateNewKey(lPredefinedKey As Long, sNewKeyName As String)
Dim hNewKey As Long
Dim lRetVal As Long
lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)
RegCloseKey (hNewKey)
End FunctionSub Main()
' 函数在注册表的"HKEY_CURRENT_USER\Software"中建立了
' 一个SubKey1项并在其中建立了值,并在显示后删除建立
' 的值,如果你想通过RegEdit看到结果,可以将最后两句
' 删除,不过要记得手动删除建立的键值
CreateNewKey HKEY_CURRENT_USER, "Software\SubKey1\SubKey2"
SetKeyValue HKEY_CURRENT_USER, "Software\SubKey1\SubKey2", "Test", "This is just a test", REG_SZ
MsgBox QueryValue(HKEY_CURRENT_USER, "Software\SubKey1\SubKey2", "Test")
DeleteValue HKEY_CURRENT_USER, "Software\SubKey1\SubKey2", "Test"
DeleteKey HKEY_CURRENT_USER, "Software\SubKey1\SubKey2"
End Sub
Public Function SetKeyValue(lPredefinedKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)
Dim lRetVal As Long
Dim hKey As Long lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
RegCloseKey (hKey)
End FunctionPublic Function QueryValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)
Dim lRetVal As Long
Dim hKey As Long
Dim vValue As Variant
lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = QueryValueEx(hKey, sValueName, vValue)
QueryValue = vValue
RegCloseKey (hKey)
End Function
Dim x As New IWshRuntimeLibrary.WshShell
Dim buffer0 As Variant
'buffer0 即为二进制流
buffer0 = x.RegRead("HKEY_CLASSES_ROOT\.UDL\ShellNew\Data")Dim i As Long
Dim buffer() As Byte
ReDim buffer(LBound(buffer0) To UBound(buffer0)) As Byte
'将 buffer0 复制为 buffer
For i = LBound(buffer) To UBound(buffer)
buffer(i) = buffer0(i)
Debug.Print "&H" & VBA.Hex(buffer(i))
Next i