VB 程序 vista 写注册表
VERSION 5.00
Begin VB.Form Form1
Caption = “Form1″
ClientHeight = 5805
ClientLeft = 120
ClientTop = 420
ClientWidth = 8610
LinkTopic = “Form1″
ScaleHeight = 5805
ScaleWidth = 8610
StartUpPosition = 3 ‘Windows Default
Begin VB.TextBox Text2
Height = 345
Left = 3000
TabIndex = 9
Text = “Text2″
Top = 360
Width = 2835
End
Begin VB.TextBox Text1
Height = 345
Left = 600
TabIndex = 8
Text = “Text1″
Top = 270
Width = 1785
End
Begin VB.CommandButton Command2
Caption = “Command2″
Height = 525
Left = 3720
TabIndex = 1
Top = 1140
Width = 1245
End
Begin VB.CommandButton Command1
Caption = “Command1″
Height = 525
Left = 2430
TabIndex = 0
Top = 1170
Width = 1245
End
Begin VB.Label Label6
Caption = “Label6″
Height = 795
Left = 5160
TabIndex = 7
Top = 3750
Width = 2295
End
Begin VB.Label Label5
Caption = “Label5″
Height = 405
Left = 2640
TabIndex = 6
Top = 3750
Width = 1425
End
Begin VB.Label Label4
Caption = “Label4″
Height = 1125
Left = 1200
TabIndex = 5
Top = 3750
Width = 2625
End
Begin VB.Label Label3
Caption = “Label3″
Height = 645
Left = 5820
TabIndex = 4
Top = 2580
Width = 1995
End
Begin VB.Label Label2
Caption = “Label2″
Height = 645
Left = 3600
TabIndex = 3
Top = 2700
Width = 1635
End
Begin VB.Label Label1
Caption = “Label1″
Height = 465
Left = 1530
TabIndex = 2
Top = 2790
Width = 1605
End
End
Attribute VB_Name = “Form1″
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function RegCreateKey Lib “advapi32.dll” Alias “RegCreateKeyA” (ByVal hKey As Long, ByVal lpSubKey As String, phkResult 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 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
Const error_success = 0&
Const error_baddb = 1009&
Const error_badkey = 1010&
Const error_cantopen = 1011&
Const error_cantread = 1012&
Const error_cantwrite = 1013&
Const error_registry_recovered = 1014&
Const error_registry_corrupt = 1015&
Const error_registry_io_failed = 1016&
Const hkey_classes_root = &H80000000
Const hkey_current_user = &H80000001
Const hkey_local_machine = &H80000002
Const REG_SZ = 1
Const regkey = “softwareMy SoftMy program”
‘接着为各个控件添加代码，代码如下：
Private Sub Command1_Click()
Dim keyvalue As String
Dim retvalue As Long
Dim keyid As Long
retvalue = RegCreateKey(key_local_machine, regkey, keyid)
keyvalue = Text1.Text
retvalue = RegSetValueEx(keyid, “注册名”, 0&, REG_SZ, ByVal keyvalue, Len(keyvalue) + 1)
keyvalue = Text2.Text
retvalue = RegSetValueEx(keyid, “注册公司”, 0&, REG_SZ, ByVal keyvalue, Len(keyvalue) + 1)
If Text1.Text <> “” And Text2.Text <> “” Then
Label3.Caption = Text1.Text
Label5.Caption = Text2.Text
End If
End Sub
Private Sub Command2_Click()
Unload Me
End
End Sub
Private Sub Form_Load()
Dim retvalue As Long
Dim result As Long
Dim keyid As Long
Dim keyvalue As String
Dim subkey As String
Dim bufsize As Long
Label6.Caption = regkey
retvalue = RegCreateKey(hkey_local_machine, regkey, keyid)
If retvalue = 0 Then
subkey = “注册名”
retvalue = RegQueryValueEx(keyid, subkey, 0&, REG_SZ, 0&, bufsize)
If bufsize < 2 Then
keyvalue = “”
retvalue = RegSetValueEx(keyid, subkey, 0&, REG_SZ, ByVal keyvalue, Len(keyvalue) + 1)
Else
keyvalue = String(bufsize + 1, ” “)
retvalue = RegQueryValueEx(keyid, subkey, 0&, REG_SZ, ByVal keyvalue, bufsize)
keyvalue = Left$(keyvalue, bufsize - 1)
Text1.Text = keyvalue
End If
Label3.Caption = keyvalue
subkey = “注册公司”
retvalue = RegQueryValueEx(keyid, subkey, 0&, REG_SZ, 0&, bufsize)
If bufsize < 2 Then
keyvalue = “”
retvalue = RegSetValueEx(keyid, subkey, 0&, REG_SZ, ByVal keyvalue, Len(keyvalue) + 1)
Else
keyvalue = String(bufsize + 1, ” “)
retvalue = RegQueryValueEx(keyid, subkey, 0&, REG_SZ, ByVal keyvalue, bufsize)
keyvalue = Left$(keyvalue, bufsize - 1)
Text2.Text = keyvalue
End If
Label5.Caption = keyvalue
End If
End Sub
