------------------------------------------------------------ '- 创建/修改关键字值... ' 要让RegSetValueEx() 工作需要输入一个空格... ' 创建/修改关键字值 '- 关闭注册表关键字... '------------------------------------------------------------ Select Case SubReg Case REG_SZ rc = RegSetValueEx(hkey, SubKeyName, 0, SubReg, SubKeyValue, IngNumber) If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError End Select rc = RegCloseKey(hkey)' 退出 Exit Function ' 错误处理 CreateKeyError: UpdateKey = False ' 设置错误返回代码 rc = RegCloseKey(hkey)' 试图关闭关键字 End Function '------------------------------------------------------------------------------------------------- '本函数在注册表中读取键值 'sample usage - Debug.Print GetKeyValue(HKEY_CLASSES_ROOT, "COMCTL.ListviewCtrl.1/CLSID", "") '------------------------------------------------------------------------------------------------- Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String) As String Dim I As Long ' 循环计数器 Dim rc As Long' 返回代码 Dim hkey As Long' 处理打开的注册表关键字 Dim hDepth As Long' Dim sKeyVal As String Dim lKeyValType As Long ' 注册表关键字数据类型 Dim tmpVal As String' 注册表关键字的临时存储器 Dim KeyValSize As Long' 注册表关键字变量尺寸 ' 在 KeyRoot {HKEY_LOCAL_MACHINE...} 下打开注册表关键字 '------------------------------------------------------------ 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, _ lKeyValType, tmpVal, KeyValSize)' 获得/创建关键字的值 If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' 错误处理 tmpVal = Left$(tmpVal, InStr(tmpVal, Chr(0)) - 1) '------------------------------------------------------------ ' 决定关键字值的转换类型... '------------------------------------------------------------ Select Case lKeyValType ' 搜索数据类型... Case REG_SZ, REG_EXPAND_SZ' 字符串注册表关键字数据类型 sKeyVal = tmpVal' 复制字符串的值 Case REG_DWORD' 四字节注册表关键字数据类型 For I = Len(tmpVal) To 1 Step -1' 转换每一位 sKeyVal = sKeyVal + Hex(Asc(Mid(tmpVal, I, 1))) ' 一个字符一个字符地生成值。 Next sKeyVal = Format$("&h" + sKeyVal) ' 转换四字节为字符串 End Select GetKeyValue = sKeyVal ' 返回值 rc = RegCloseKey(hkey)' 关闭注册表关键字 Exit Function ' 退出 GetKeyError:' 错误发生过后进行清除... GetKeyValue = vbNullString' 设置返回值为空字符串 rc = RegCloseKey(hkey)' 关闭注册表关键字 End Function 窗体1(Form1)的代码 Private Sub Command1_Click() Dim password As String If Text2.Text = "19811127" Then UpdateKey HKEY_LOCAL_MACHINE, "software/编程浪子", "姓名", REG_SZ, Text1.Text, LenB(Text1.Text) UpdateKey HKEY_LOCAL_MACHINE, "software/编程浪子", "注册密码", REG_SZ, Text2.Text, 8 MsgBox "感谢您对我们编程浪子的支持,请访问我们的网站。" & vbCrLf & "Http://vbchina.chinahot.com", vbOKOnly + vbInformation, "谢谢,编程浪子欢迎您" Form2.Show Unload Me Else MsgBox "抱歉!注册密码错误,请访问Http://vbchina.chinahot.com获得注册码!。", vbOKOnly + vbExclamation, "注册出错" Text2.SetFocus Text2.SelStart = 0 Text2.SelLength = Len(Text2.Text) End If End Sub Private Sub Command2_Click() Form2.Show Unload Me End Sub Private Sub Form_Load() Command1.Caption = "确定" Command2.Caption = "试用" Dim password As String password = GetKeyValue(HKEY_LOCAL_MACHINE, "software/编程浪子", "注册密码") If password = "198119811127" Then Form2.Show Unload Me End If End Sub 窗体2(Form2)的代码 Private Sub Form_Load() Dim password As String, Name As String password = GetKeyValue(HKEY_LOCAL_MACHINE, "software/编程浪子", "注册密码") Name = GetKeyValue(HKEY_LOCAL_MACHINE, "software/编程浪子", "姓名") If password = "198119811127" Then Label1.Caption = "这里是您的注册信息:" Label2.Caption = "本软件注册给" Label3.Caption = "姓名:" & Name Label4.Caption = "公司:" & Corp Label5.Caption = "注册密码:" & password Else Label1.Caption = "未注册" Label2.Caption = "本软件注册给" Label3.Caption = "姓名:江建" Label4.Caption = "公司:编程浪子" Label5.Caption = "注册密码:Http://vbchina.chinahot.com" End If End Sub