用VB读取注册表数据

用VB读取注册表数据

原则上同意 VB问题大王 - 助理 二级

不过也有其他办法，

添加一个模块，写入如下内容：，在需要的地方调用这里的子程序就行了

你的就写成这样：

Text1.Text = GetStringValue(HKEY_LOCAL_MACHINE, "HARDWARE\DESCRIPTION\System\CentralProcessor\0", "ProcessorNameString")

=====================

’以下是模块中的内容

'注册表的入口常量

Public Const HKEY_CLASSES_ROOT = &H80000000

Public Const HKEY_CURRENT_USER = &H80000001

Public Const HKEY_LOCAL_MACHINE = &H80000002

Public Const HKEY_USERS = &H80000003

Public Const HKEY_PERFORMANCE_DATA = &H80000004

Public Const ERROR_SUCCESS = 0&

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long

Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long

Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult 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 RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData 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 RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long

Public Const REG_SZ = 1

Public Const REG_DWORD = 4

Public Sub savekey(hKey As Long, strPath As String)

Dim keyhand&

r = RegCreateKey(hKey, strPath, keyhand&)

r = RegCloseKey(keyhand&)

End Sub

Public Function GetStringValue(hKey As Long, strPath As String, strValue As String)

Dim keyhand As Long

Dim datatype As Long

Dim lResult As Long

Dim strBuf As String

Dim lDataBufSize As Long

Dim intZeroPos As Integer

r = RegOpenKey(hKey, strPath, keyhand)

lResult = RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&, lDataBufSize)

If lValueType = REG_SZ Then

strBuf = String(lDataBufSize, " ")

lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, ByVal strBuf, lDataBufSize)

If lResult = ERROR_SUCCESS Then

intZeroPos = InStr(strBuf, Chr$(0))

If intZeroPos > 0 Then

GetStringValue = Left$(strBuf, intZeroPos - 1)

Else

GetStringValue = strBuf

End If

End If

End If

End Function

Public Sub SetStringValue(hKey As Long, strPath As String, strValue As String, strdata As String)

Dim keyhand As Long

Dim r As Long

r = RegCreateKey(hKey, strPath, keyhand)

r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))

r = RegCloseKey(keyhand)

End Sub

Function GetDwordValue(ByVal hKey As Long, ByVal strPath As String, ByVal strValueName As String) As Long

Dim lResult As Long

Dim lValueType As Long

Dim lBuf As Long

Dim lDataBufSize As Long

Dim r As Long

Dim keyhand As Long

r = RegOpenKey(hKey, strPath, keyhand)

lDataBufSize = 4

lResult = RegQueryValueEx(keyhand, strValueName, 0&, lValueType, lBuf, lDataBufSize)

If lResult = ERROR_SUCCESS Then

If lValueType = REG_DWORD Then

GetDwordValue = lBuf

End If

End If

r = RegCloseKey(keyhand)

End Function

Function SetDwordValue(ByVal hKey As Long, ByVal strPath As String, ByVal strValueName As String, ByVal lData As Long)

Dim lResult As Long

Dim keyhand As Long

Dim r As Long

r = RegCreateKey(hKey, strPath, keyhand)

lResult = RegSetValueEx(keyhand, strValueName, 0&, REG_DWORD, lData, 4)

r = RegCloseKey(keyhand)

End Function

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 Function

Public 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 Function

Public 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 = RegQueryValueEx(hKey, sValueName, vValue, 0, 0, 0)

QueryValue = vValue

RegCloseKey (hKey)

End Function

我这里有一个模块，直接建立一个模块，如：reg.bas

然后直接调用

GetKeyValue HKEY_LOCAL_MACHINE, "HARDWARE\DESCRIPTION\System\CentralProcessor\0", "ProcessorNameString", ProcessorNameString

Text1.Text =ProcessorNameString

就可以了

Public JAVAHOME As String, TomCatPath As String, EvrioPath As String, MySQLPath As String

Dim JavaVersion As String, TomCatVersion As String, MySQLVersion As String

' 注册表关键字安全选项...

Public Const ERROR_NO_MORE_ITEMS = 259&

Public Const READ_CONTROL = &H20000

Public Const KEY_QUERY_VALUE = &H1

Public Const KEY_SET_VALUE = &H2

Public Const KEY_CREATE_SUB_KEY = &H4

Public Const KEY_ENUMERATE_SUB_KEYS = &H8

Public Const KEY_NOTIFY = &H10

Public Const KEY_CREATE_LINK = &H20

Public Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _

KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _

KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL

Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long

Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long

Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long

Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As Any) As Long

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Enum ValueType

REG_NONE = 0

REG_SZ = 1

REG_EXPAND_SZ = 2

REG_BINARY = 3

REG_DWORD = 4

REG_DWORD_BIG_ENDIAN = 5

REG_MULTI_SZ = 7

End Enum

Enum RootKey

HKEY_CLASSES_ROOT = &H80000000

HKEY_CURRENT_USER = &H80000001

HKEY_LOCAL_MACHINE = &H80000002

HKEY_USERS = &H80000003

HKEY_PERFORMANCE_DATA = &H80000004

HKEY_CURRENT_CONFIG = &H80000005

HKEY_DYN_DATA = &H80000006

End Enum

Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean

Dim I As Long ' 循环计数器

Dim rc As Long ' 返回代码

Dim hKey As Long ' 打开的注册表关键字句柄

Dim hDepth As Long '

Dim KeyValType As Long ' 注册表关键字数据类型

Dim tmpVal As String ' 注册表关键字值的临时存储器

Dim KeyValSize As Long ' 注册表关键自变量的尺寸

'------------------------------------------------------------

' 打开 {HKEY_LOCAL_MACHINE...} 下的 RegKey

'------------------------------------------------------------

rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) '打开注册表关键字

If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' 处理错误...

tmpVal = String$(1024, 0) ' 分配变量空间

KeyValSize = 1024 ' 标记变量尺寸

'------------------------------------------------------------

' 检索注册表关键字的值...

'------------------------------------------------------------

rc = RegQueryValueEx(hKey, SubKeyRef, 0, _

KeyValType, tmpVal, KeyValSize) ' 获得/创建关键字值

If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' 处理错误

If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ' Win95 外接程序空终结字符串...

tmpVal = Left(tmpVal, KeyValSize - 1) ' Null 被找到,从字符串中分离出来

Else ' WinNT 没有空终结字符串...

tmpVal = Left(tmpVal, KeyValSize) ' Null 没有被找到, 分离字符串

End If

'------------------------------------------------------------

' 决定转换的关键字的值类型...

'------------------------------------------------------------

Select Case KeyValType ' 搜索数据类型...

Case REG_SZ ' 字符串注册关键字数据类型

KeyVal = tmpVal ' 复制字符串的值

Case REG_EXPAND_SZ

KeyVal = tmpVal

Case REG_DWORD ' 四字节的注册表关键字数据类型

For I = Len(tmpVal) To 1 Step -1 ' 将每位进行转换

KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, I, 1))) ' 生成值字符。 By Char。

Next

KeyVal = Format$("&h" + KeyVal) ' 转换四字节的字符为字符串

End Select

GetKeyValue = True ' 返回成功

rc = RegCloseKey(hKey) ' 关闭注册表关键字

Exit Function ' 退出

GetKeyError: ' 错误发生后将其清除...

KeyVal = "" ' 设置返回值到空字符串

GetKeyValue = False ' 返回失败

rc = RegCloseKey(hKey) ' 关闭注册表关键字

End Function

Set Sh = CreateObject("WScript.Shell")

Sh.RegWrite "HKEY_LOCAL_MACHINE\System\CurrentControlSet\Control\ComputerName\ComputerName\ComputerName",Num&Name,"REG_SZ"

Sh.RegWrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\NV Hostname",Num&Name,"REG_SZ"

Sh.RegWrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Hostname",Num&Name,"REG_SZ"

Set sh = Nothing

Set oShell = Nothing

strComputer = "."

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

Set colNetAdapters = objWMIService.ExecQuery _

("Select * from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")

strIPAddress = Array(Gateway&Ipnum)

strSubnetMask = Array(SubnetMask)

strGateway = Array(gateway&gatewayip)

strGatewayMetric = Array(1)

arrDNSServers = Array(Dns1,Dns2)

For Each objNetAdapter in colNetAdapters

errEnable = objNetAdapter.EnableStatic(strIPAddress, strSubnetMask)

errGateways = objNetAdapter.SetGateways(strGateway, strGatewaymetric)

errDNS=objNetAdapter.SetDNSServerSearchOrder(arrDNSServers)

Next

Set objWMIService = GetObject("winmgmts:" _

& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colComputers = objWMIService.ExecQuery _

("Select * from Win32_ComputerSystem")

For Each objComputer in colComputers

'ObjComputer.Rename(Num&Name)

Next

Set objNetworkSettings = objWMIService.Get("Win32_NetworkAdapterConfiguration")

objNetworkSettings.SetIPXVirtualNetworkNumber(Num)