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

以下控件使用默認名稱請不要改變。
1、新建兩個窗體。
2、在第一個窗體(Form1)上放置兩個文本框及兩個按鈕。
3、在第二個窗體(Form2)上放置5個標簽
4、新建一個標準模塊
您現在可以將代碼粘貼過去運行了。

模塊的代碼
Option Explicit
' 這個模塊用于讀和寫注冊表關鍵字。
' 不同于VB 的內部注冊表訪問方法，它可以
' 通過字符串的值來讀和寫任何注冊表關鍵字。
'---------------------------------------------------------------
'-注冊表 API 聲明...
'RegCloseKey 用于關閉系統注冊表中的一個項（或鍵）
'RegCreateKeyEx用于創建注冊表項
'RegOpenKeyEx用于打開注冊表項
'RegQueryValueEx 用于獲取一個項的設置值
'RegSetValueEx 用于設置指定項的值
'---------------------------------------------------------------
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
'---------------------------------------------------------------
'- 注冊表 Api 常數...
'---------------------------------------------------------------
' Reg Data Types...
Public Const REG_SZ = 1 ' Unicode空終結字符串
Public Const REG_EXPAND_SZ = 2' Unicode空終結字符串
Public Const REG_DWORD = 4' 32-bit 數字
Public Const REG_BINARY = 3
' 注冊表創建類型值...
Public Const REG_OPTION_NON_VOLATILE = 0 ' 當系統重新啟動時，關鍵字被保留
' 注冊表關鍵字安全選項...
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

' 注冊表關鍵字根類型...
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

'---------------------------------------------------------------
'- 注冊表安全屬性類型...
'---------------------------------------------------------------
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Boolean
End Type
'-------------------------------------------------------------------------------------------------
'本函數在注冊表中創建新的項及鍵值
'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' 處理一個注冊表關鍵字
Dim hDepth As Long'
Dim lpAttr As SECURITY_ATTRIBUTES ' 注冊表安全類型
lpAttr.nLength = 50 ' 設置安全屬性為缺省值...
lpAttr.lpSecurityDescriptor = 0 ' ...
lpAttr.bInheritHandle = True' ...
'------------------------------------------------------------
'- 創建/打開注冊表關鍵字...
'創建/打開//KeyRoot//KeyName
' 錯誤處理...
'------------------------------------------------------------
rc = RegCreateKeyEx(KeyRoot, KeyName, 0, "", 0, KEY_WRITE, lpAttr, hkey, hDepth)
If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError
'------------------------------------------------------------
'- 創建/修改關鍵字值...
' 要讓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