------------------------------------------------------------ '- 創建/修改關鍵字值... ' 要讓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
