為您的應(yīng)用程序加上注冊(cè)的局限

  為您的應(yīng)用程序加上注冊(cè)的限制是不是很好，至少現(xiàn)在的共享軟件都是這樣做的。 大家都用過(guò)Winzip這個(gè)軟件吧！當(dāng)未注冊(cè)時(shí)每次啟動(dòng)都會(huì)彈出個(gè)該死的對(duì)話框，只有正確的注冊(cè)后此對(duì)話框才會(huì)消失。這就是我們本次所要實(shí)現(xiàn)的目標(biāo)。對(duì)于這些信息我們將其存儲(chǔ)在注冊(cè)表中VB6.0提供了一個(gè)函數(shù)及一條語(yǔ)句用于讀寫注冊(cè)表它們是GetSetting 和 SaveSetting 遺憾的是我們不能用它將鍵值 寫在注冊(cè)表的任意位置。難道就沒(méi)有別的函數(shù)了嗎？NO！有！那就是Micro$oft的Win32 API 它所提供的 函數(shù)可以讓我們隨意的讀寫注冊(cè)表的任何位置包括新建鍵值、刪除鍵值、新建項(xiàng)目等等……。廢話就不多 說(shuō)了我們還是先來(lái)看看如何實(shí)現(xiàn)吧！

以下控件使用默認(rèn)名稱請(qǐng)不要改變。
1、新建兩個(gè)窗體。
2、在第一個(gè)窗體(Form1)上放置兩個(gè)文本框及兩個(gè)按鈕。
3、在第二個(gè)窗體(Form2)上放置5個(gè)標(biāo)簽
4、新建一個(gè)標(biāo)準(zhǔn)模塊
您現(xiàn)在可以將代碼粘貼過(guò)去運(yùn)行了。

模塊的代碼
Option Explicit
' 這個(gè)模塊用于讀和寫注冊(cè)表關(guān)鍵字。
' 不同于VB 的內(nèi)部注冊(cè)表訪問(wèn)方法，它可以
' 通過(guò)字符串的值來(lái)讀和寫任何注冊(cè)表關(guān)鍵字。
'---------------------------------------------------------------
'-注冊(cè)表 API 聲明...
'RegCloseKey 用于關(guān)閉系統(tǒng)注冊(cè)表中的一個(gè)項(xiàng)（或鍵）
'RegCreateKeyEx用于創(chuàng)建注冊(cè)表項(xiàng)
'RegOpenKeyEx用于打開(kāi)注冊(cè)表項(xiàng)
'RegQueryValueEx 用于獲取一個(gè)項(xiàng)的設(shè)置值
'RegSetValueEx 用于設(shè)置指定項(xiàng)的值
'---------------------------------------------------------------
Public Declare Function RegCloseKey Lib "advapi32" (ByVal hkey As Long) As Long
Public Declare Function RegCreateKeyEx Lib "advapi32" Alias "RegCreateKeyExA" (ByVal hkey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, ByRef phkResult As Long, ByRef lpdwDisposition As Long) As Long
Public 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
Public 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
Public Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" (ByVal hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
'---------------------------------------------------------------
'- 注冊(cè)表 Api 常數(shù)...
'---------------------------------------------------------------
' Reg Data Types...
Public Const REG_SZ = 1 ' Unicode空終結(jié)字符串
Public Const REG_EXPAND_SZ = 2' Unicode空終結(jié)字符串
Public Const REG_DWORD = 4' 32-bit 數(shù)字
Public Const REG_BINARY = 3
' 注冊(cè)表創(chuàng)建類型值...
Public Const REG_OPTION_NON_VOLATILE = 0 ' 當(dāng)系統(tǒng)重新啟動(dòng)時(shí)，關(guān)鍵字被保留
' 注冊(cè)表關(guān)鍵字安全選項(xiàng)...
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_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL
Public Const KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY + READ_CONTROL
Public Const KEY_EXECUTE = KEY_READ
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

' 注冊(cè)表關(guān)鍵字根類型...
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_NONE = 0
Public Const ERROR_BADKEY = 2
Public Const ERROR_ACCESS_DENIED = 8
Public Const ERROR_SUCCESS = 0

'---------------------------------------------------------------
'- 注冊(cè)表安全屬性類型...
'---------------------------------------------------------------
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Boolean
End Type
'-------------------------------------------------------------------------------------------------
'本函數(shù)在注冊(cè)表中創(chuàng)建新的項(xiàng)及鍵值
'sample usage - Debug.Print UpodateKey(HKEY_CLASSES_ROOT, "keyname", "newvalue")
'-------------------------------------------------------------------------------------------------
Public Function UpdateKey(KeyRoot As Long, KeyName As String, SubKeyName As String, SubReg As Long, SubKeyValue As String, IngNumber As Long) As Long
Dim rc As Long' 返回代碼
Dim hkey As Long' 處理一個(gè)注冊(cè)表關(guān)鍵字
Dim hDepth As Long'
Dim lpAttr As SECURITY_ATTRIBUTES ' 注冊(cè)表安全類型
lpAttr.nLength = 50 ' 設(shè)置安全屬性為缺省值...
lpAttr.lpSecurityDescriptor = 0 ' ...
lpAttr.bInheritHandle = True' ...
'------------------------------------------------------------
'- 創(chuàng)建/打開(kāi)注冊(cè)表關(guān)鍵字...
'創(chuàng)建/打開(kāi)//KeyRoot//KeyName
' 錯(cuò)誤處理...
'------------------------------------------------------------
rc = RegCreateKeyEx(KeyRoot, KeyName, 0, "", 0, KEY_WRITE, lpAttr, hkey, hDepth)
If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError
'------------------------------------------------------------
'- 創(chuàng)建/修改關(guān)鍵字值...
' 要讓RegSetValueEx() 工作需要輸入一個(gè)空格...
' 創(chuàng)建/修改關(guān)鍵字值
'- 關(guān)閉注冊(cè)表關(guān)鍵字...
'------------------------------------------------------------
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 ' 錯(cuò)誤處理
CreateKeyError:
UpdateKey = False ' 設(shè)置錯(cuò)誤返回代碼
rc = RegCloseKey(hkey)' 試圖關(guān)閉關(guān)鍵字
End Function

'-------------------------------------------------------------------------------------------------
'本函數(shù)在注冊(cè)表中讀取鍵值
'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 ' 循環(huán)計(jì)數(shù)器
Dim rc As Long' 返回代碼
Dim hkey As Long' 處理打開(kāi)的注冊(cè)表關(guān)鍵字
Dim hDepth As Long'
Dim sKeyVal As String
Dim lKeyValType As Long ' 注冊(cè)表關(guān)鍵字?jǐn)?shù)據(jù)類型
Dim tmpVal As String' 注冊(cè)表關(guān)鍵字的臨時(shí)存儲(chǔ)器
Dim KeyValSize As Long' 注冊(cè)表關(guān)鍵字變量尺寸
' 在 KeyRoot {HKEY_LOCAL_MACHINE...} 下打開(kāi)注冊(cè)表關(guān)鍵字
'------------------------------------------------------------
rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hkey) ' 打開(kāi)注冊(cè)表關(guān)鍵字
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError' 處理錯(cuò)誤...
tmpVal = String$(1024, 0) ' 分配變量空間
KeyValSize = 1024 ' 標(biāo)記變量尺寸
'------------------------------------------------------------
' 檢索注冊(cè)表關(guān)鍵字的值...
'------------------------------------------------------------
rc = RegQueryValueEx(hkey, SubKeyRef, 0, _
lKeyValType, tmpVal, KeyValSize)' 獲得/創(chuàng)建關(guān)鍵字的值
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' 錯(cuò)誤處理
tmpVal = Left$(tmpVal, InStr(tmpVal, Chr(0)) - 1)
'------------------------------------------------------------
' 決定關(guān)鍵字值的轉(zhuǎn)換類型...
'------------------------------------------------------------
Select Case lKeyValType ' 搜索數(shù)據(jù)類型...
Case REG_SZ, REG_EXPAND_SZ' 字符串注冊(cè)表關(guān)鍵字?jǐn)?shù)據(jù)類型
sKeyVal = tmpVal' 復(fù)制字符串的值
Case REG_DWORD' 四字節(jié)注冊(cè)表關(guān)鍵字?jǐn)?shù)據(jù)類型
For I = Len(tmpVal) To 1 Step -1' 轉(zhuǎn)換每一位
sKeyVal = sKeyVal + Hex(Asc(Mid(tmpVal, I, 1))) ' 一個(gè)字符一個(gè)字符地生成值。
Next
sKeyVal = Format$("&h" + sKeyVal) ' 轉(zhuǎn)換四字節(jié)為字符串
End Select

GetKeyValue = sKeyVal ' 返回值
rc = RegCloseKey(hkey)' 關(guān)閉注冊(cè)表關(guān)鍵字
Exit Function ' 退出
GetKeyError:' 錯(cuò)誤發(fā)生過(guò)后進(jìn)行清除...
GetKeyValue = vbNullString' 設(shè)置返回值為空字符串
rc = RegCloseKey(hkey)' 關(guān)閉注冊(cè)表關(guān)鍵字
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\編程浪子", "注冊(cè)密碼", REG_SZ, Text2.Text, 8
MsgBox "感謝您對(duì)我們編程浪子的支持,請(qǐng)?jiān)L問(wèn)我們的網(wǎng)站。" & vbCrLf & "Http://vbchina.chinahot.com", vbOKOnly + vbInformation, "謝謝，編程浪子歡迎您"
Form2.Show
Unload Me
Else
MsgBox "抱歉！注冊(cè)密碼錯(cuò)誤，請(qǐng)?jiān)L問(wèn)Http://vbchina.chinahot.com獲得注冊(cè)碼！。", vbOKOnly + vbExclamation, "注冊(cè)出錯(cuò)"
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\編程浪子", "注冊(cè)密碼")
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\編程浪子", "注冊(cè)密碼")
Name = GetKeyValue(HKEY_LOCAL_MACHINE, "software\編程浪子", "姓名")
If password = "198119811127" Then
Label1.Caption = "這里是您的注冊(cè)信息："
Label2.Caption = "本軟件注冊(cè)給"
Label3.Caption = "姓名：" & Name
Label4.Caption = "公司：" & Corp
Label5.Caption = "注冊(cè)密碼：" & password
Else
Label1.Caption = "未注冊(cè)"
Label2.Caption = "本軟件注冊(cè)給"
Label3.Caption = "姓名：江建"
Label4.Caption = "公司：編程浪子"
Label5.Caption = "注冊(cè)密碼：Http://vbchina.chinahot.com"
End If
End Sub