如何用VB读写注册表！！

[zhngxVPP]

我用VB开发了一个数据库程序，连接数据库的名称和密码以及帐户名都想写进注册表，但该如何读写注册表呢？？以及该注意些什么问题 请高手指点

[thht1234]

视频会议源码,超低价。请试用！
支持16路视频，采用H264压缩算法，支持混音，可以多人同时说话。
支持白板，浏览器共享，屏幕演示，视频广播。
可以录制视频会议。
价谦物美，可以用来修改成视频会议，收费性质的聊天室。
9158聊天室,www.56.com可用我这套代码修改而成。
联系QQ：544867088

[51365133]

http://community.csdn.net/Expert/topic/4725/4725947.xml?temp=.6932184

[randomx]

google一下一大堆 自己先研究一下吧

[bluesky23]

'以下是一段完整的代码，楼主可以参考一下

Option Explicit

' True if showing classes.
Dim ShowClass As Boolean

Private Sub cmdMathProcessor_Click()
MsgBox "Math Processor: " & IIf(MathProcessor, "FOUND", "NOT FOUND"), vbInformation
End Sub

Private Sub cmdVbSettings_Click()
Dim msg As String
msg = "FontHeight = " & GetRegistryValue(HKEY_CURRENT_USER, "Software\Microsoft\VBA\Microsoft Visual Basic", "FontHeight", REG_DWORD) & vbCr
msg = msg & "FontFace = " & GetRegistryValue(HKEY_CURRENT_USER, "Software\Microsoft\VBA\Microsoft Visual Basic", "FontFace", REG_SZ)
MsgBox msg, vbInformation
End Sub

Private Sub cmdCreate_Click()
CreateRegistryKey HKEY_CURRENT_USER, "Software\YourCompany"
MsgBox "Created the HKEY_CURRENT_USER\Software\YourCompany key", vbInformation

CreateRegistryKey HKEY_CURRENT_USER, "Software\YourCompany\YourApplication"
MsgBox "Created the HKEY_CURRENT_USER\Software\YourCompany\YourApplication key", vbInformation

SetRegistryValue HKEY_CURRENT_USER, "Software\YourCompany\YourApplication", "LastLogin", REG_SZ, FormatDateTime(Now)
MsgBox "Created the HKEY_CURRENT_USER\Software\YourCompany\YourApplication\LastLogin value", vbInformation

DeleteRegistryValue HKEY_CURRENT_USER, "Software\YourCompany\YourApplication", "LastLogin"
MsgBox "Deleted the HKEY_CURRENT_USER\Software\YourCompany\YourApplication\LastLogin value", vbInformation

DeleteRegistryKey HKEY_CURRENT_USER, "Software\YourCompany\YourApplication"
MsgBox "Deleted the HKEY_CURRENT_USER\Software\YourCompany\YourApplication key", vbInformation

DeleteRegistryKey HKEY_CURRENT_USER, "Software\YourCompany"
MsgBox "Deleted the HKEY_CURRENT_USER\Software\YourCompany key", vbInformation

End Sub

Private Sub cmdEnumKeys_Click()
Dim keys() As String, i As Long
keys() = EnumRegistryKeys(HKEY_CLASSES_ROOT, "")

' Filter out a few special items
For i = LBound(keys) To UBound(keys)
If Left$(keys(i), 1) = "." Then
' these are reserved names.
keys(i) = vbNullChar
Else
' filter out some non-component names.
Select Case keys(i)
Case "*", "CLSID", "AppID", "Component Categories"
keys(i) = vbNullChar
End Select
End If
Next
keys() = Filter(keys(), vbNullChar, False)

List1.Clear
For i = LBound(keys) To UBound(keys)
List1.AddItem keys(i)
Next
ShowClass = True

End Sub

Private Sub List1_Click()
' exit if not showing classes.
If Not ShowClass Then Exit Sub

Dim clsid As String, descr As String
Dim key As String, value As String

' Try to open the CLSID key.
clsid = GetRegistryValue(HKEY_CLASSES_ROOT, List1.Text & "\CLSID", "", REG_SZ, "")
If Len(clsid) = 0 Then
descr = "CLSID not found"
Else
descr = "CLSID = " & clsid & vbCrLf
' Try to open the InProcServer key.
key = "CLSID\" & clsid & "\InProcServer32"
value = GetRegistryValue(HKEY_CLASSES_ROOT, key, "", REG_SZ, "")
If Len(value) Then
descr = descr & "InProcServer = " & value & vbCrLf
End If
' Try to open the LocalServer32 key.
key = "CLSID\" & clsid & "\LocalServer32"
value = GetRegistryValue(HKEY_CLASSES_ROOT, key, "", REG_SZ, "")
If Len(value) Then
descr = descr & "InProcServer = " & value & vbCrLf
End If

End If

lblDescription = descr

End Sub

Private Sub cmdEnumValues_Click()
Dim values() As Variant, i As Long, descr As String
values() = EnumRegistryValues(HKEY_CURRENT_USER, "Software\Microsoft\VBA\Microsoft Visual Basic")

List1.Clear
For i = LBound(values, 2) To UBound(values, 2)
List1.AddItem values(0, i) & " = " & ValueDescription(values(1, i))
Next
ShowClass = False
End Sub

' Convert a value into a printable description.

Private Function ValueDescription(value As Variant) As String
If VarType(value) = vbLong Then
ValueDescription = value
ElseIf VarType(value) = vbString Then
ValueDescription = """" & value & """"
ElseIf VarType(value) = vbArray + vbByte Then
Dim i As Long, buffer As String
For i = LBound(value) To UBound(value)
buffer = buffer & Right$("0" & Hex$(value(i)), 2) & " "
Next
ValueDescription = buffer
Else
ValueDescription = "[ unsupported data type ]"
End If


End Function

[bluesky23]

Option Explicit

Private 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
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey 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, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As Long, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition 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 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 RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) 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 Any, lpcbData As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, source As Any, ByVal numBytes As Long)

Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long

Const SYNCHRONIZE = &H100000
Const READ_CONTROL = &H20000
Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Const STANDARD_RIGHTS_ALL = &H1F0000

Const KEY_QUERY_VALUE = &H1
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_READ = ((READ_CONTROL Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))

Const ERROR_SUCCESS = 0&

Public Const REG_SZ = 1
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4

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 HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006

Public Const REG_CREATED_NEW_KEY = &H1
Public Const REG_OPENED_EXISTING_KEY = &H2

' Return True if the system has a math processor.

Function MathProcessor() As Boolean
Dim hKey As Long, key As String
key = "HARDWARE\DESCRIPTION\System\FloatingPointProcessor"
If RegOpenKeyEx(HKEY_LOCAL_MACHINE, key, 0, KEY_READ, hKey) = 0 Then
' If the open operation succeeded, the key exists
MathProcessor = True
' Important: close the key before exiting.
RegCloseKey hKey
End If
End Function

' Test if a Registry key exists.

Function CheckRegistryKey(ByVal hKey As Long, ByVal KeyName As String) As Boolean
Dim handle As Long
' Try to open the key.
If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) = 0 Then
' The key exists.
CheckRegistryKey = True
' Close it before exiting.
RegCloseKey handle
End If
End Function

' Create a registry key, then close it.
' Returns True if the key already existed, False if it was created.

Function CreateRegistryKey(ByVal hKey As Long, ByVal KeyName As String) As Boolean
Dim handle As Long, disposition As Long
If RegCreateKeyEx(hKey, KeyName, 0, 0, 0, 0, 0, handle, disposition) Then
Err.Raise 1001, , "Unable to create the registry key"
Else
' Return True if the key already existed.
CreateRegistryKey = (disposition = REG_OPENED_EXISTING_KEY)
' Close the key.
RegCloseKey handle
End If
End Function

[xiaoyaofan]

这摸一大堆晕死了

[xiaoyaofan]

randomx(randomx)说的轻松，google里哪有一大堆啊！！！

[bulletCoderHope]

Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_BINARY = 3 ' Free form binary
Const HKEY_CURRENT_USER = &H80000001
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public 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
Public 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
Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) As String
Dim lResult As Long, lValueType As Long, strBuf As String, lDataBufSize As Long
'retrieve nformation about the key
lResult = RegQueryValueEx(hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize) 'ByVal 0，在这里是不需要返回要读取的数据？而只是返回lValueType数据类型和lDataBufSize数据长度？
If lResult = 0 Then
If lValueType = REG_SZ Then
'Create a buffer
strBuf = String(lDataBufSize, Chr$(0))
'retrieve the key's content
lResult = RegQueryValueEx(hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize) '这里是不需要返回数据类型，而返回具体数值和数据类型？
If lResult = 0 Then
'Remove the unnecessary chr$(0)'s
RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
End If
ElseIf lValueType = REG_BINARY Then
Dim strData As Integer
'retrieve the key's value
lResult = RegQueryValueEx(hKey, strValueName, 0, 0, strData, lDataBufSize)
If lResult = 0 Then
RegQueryStringValue = strData '二进制数据可以直接返回
End If
End If
End If
End Function
'读取键值
Function GetString(hKey As Long, strPath As String, strValue As String)
Dim Ret
'Open the key
RegOpenKey hKey, strPath, Ret
'Get the key's content
GetString = RegQueryStringValue(Ret, strValue)
'Close the key
RegCloseKey Ret
End Function
'创建新键并设置起键值
Sub SaveString(hKey As Long, strPath As String, strValue As String, strData As String)
Dim Ret
'Create a new key
RegCreateKey hKey, strPath, Ret '创建新子键后Ret返回的是新创建的子键的句柄
'Save a string to the key
RegSetValueEx Ret, strValue, 0, REG_SZ, ByVal strData, Len(strData)
'close the key
RegCloseKey Ret
End Sub
'创建并设置其二进制值和数据长度
Sub SaveStringLong(hKey As Long, strPath As String, strValue As String, strData As String)
Dim Ret
'Create a new key
RegCreateKey hKey, strPath, Ret
'Set the key's value
RegSetValueEx Ret, strValue, 0, REG_SZ, ByVal strData, Len(strData)
'close the key
RegCloseKey Ret
End Sub
Sub DelSetting(hKey As Long, strPath As String, strValue As String)
Dim Ret
'Create a new key
RegCreateKey hKey, strPath, Ret
'Delete the key's value
RegDeleteValue Ret, strValue
'close the key
RegCloseKey Ret
End Sub

Dim FirstRunTime As String
a= GetString(HKEY_CURRENT_USER, "Microsoft\InternetExplorer\International\Scripts\1216", "NowTime")
If a= "" Then
SaveStringLong HKEY_CURRENT_USER, "Microsoft\InternetExplorer\International\Scripts\1216", "NowTime", CStr(Now)

以上代码是我最近才亲手所写,希望对你有帮助