注册码算法问题~！！

[麦子VISA]

注册码：8位纯数字~！
根据某种算法，计算得出3-9之间的结果数字~！！
当然注册码首先要有加密保护功能~！不能一猜就破，最好随机生成后~！
不要太多，也不要太少~！！

希望ggjj们鼎力相助~！！！！

[麦子VISA]

是：结果不要太多，也不要太少~！！

[Sunron128]

Option Explicit

Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" _
(ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, _
ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _
ByVal nFileSystemNameSize As Long) As Long

Private Declare Function WriteProfileString Lib "kernel32" Alias "WriteProfileStringA" _
(ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Long

Dim sClick As String

Public Property Get ClickInfo() As String
ClickInfo = UCase(sClick)
End Property

Private Sub cmdCancel_Click()
sClick = "Cancel"
Unload Me
End Sub

Private Sub cmdOrder_Click()
If Trim(Text1.Text) = "" Then
Text1.SetFocus
Else
If CheckRegKey(Trim(Text1.Text)) = False Then
MsgBox "蛁聊鎢渣昫ㄛ笭陔怀ㄐ", vbCritical, "渣昫"
cmdOrder.Caption = "怀蛁聊鎢 [&O]"
Text1.Text = ""
Else
sClick = "order"
Call WriteRegKey
Unload Me
End If
End If
End Sub

Private Sub cmdTest_Click()
sClick = "Later"
Call WriteRegDate
Unload Me
End Sub

Private Sub Form_Load()

cmdTest.Enabled = blnData

Label3.Caption = GetSerial

Picture1.Height = lblBottom.Top + lblBottom.Height + 120

Me.Width = Label1(7).Width + 240 + 180: Me.Height = Picture1.Height + Frame1.Height + cmdCancel.Height + 600
End Sub

Private Sub Form_Resize()
On Error Resume Next

Me.Top = (Screen.Height - Me.Height) / 2
Me.Left = (Screen.Width - Me.Width) / 2

lblBottom.Left = (Picture1.ScaleWidth - lblBottom.Width) / 2

Frame1.Top = Picture1.Height
Frame1.Left = 0
Frame1.Width = Me.ScaleWidth
Label2(0).Left = (Frame1.Width - Label2(0).Width - Label3.Width) / 2
Label3.Left = Label2(0).Left + Label2(0).Width
Label2(1).Left = Label2(0).Left
Text1.Left = Label3.Left

cmdCancel.Top = Frame1.Top + Frame1.Height + 120
cmdCancel.Left = 120

cmdTest.Top = cmdCancel.Top
cmdTest.Left = Me.ScaleWidth - 120 - cmdTest.Width

cmdOrder.Top = cmdCancel.Top
cmdOrder.Left = cmdTest.Left - cmdOrder.Width - 120
End Sub

Private Function GetSerial() As String
'髡夔ㄩ蔚坋輛秶杅趼 oData 蛌遙峈匐輛秶杅趼
Dim k As Integer
Dim oData As Long

oData = SerialNumber

Do While oData >= 8
k = oData Mod 8
GetSerial = k & GetSerial
oData = oData \ 8
Loop
If oData > 0 Then GetSerial = oData & GetSerial
End Function

Private Function CheckRegKey(vData As String) As Boolean
'髡夔ㄩ潰桄怀腔蛁聊鎢岆瘁淏ㄛTrue => 淏ㄛFalse => 囮啖
'笢 vData 峈蛁聊鎢

If UCase(BreakRegKey(vData)) = UCase(Hex(SerialNumber)) Then
CheckRegKey = True
Else
CheckRegKey = False
End If
Quit_Check:
Exit Function
End Function

Private Function SerialNumber() As Long
'髡夔ㄩ跦擂茞攫煦陓洘鳳腕蛁聊陓洘(翋猁岆?煦)
Dim lpVolumeNameBuffer As String * 128
Dim lpVolumeSerialNumber As Long
Dim lpMaximumComponentLength As Long
Dim lpFileSystemFlags As Long
Dim lpFileSystemNameBuffer As String
Dim nFileSystemNameSize As Long

GetVolumeInformation "C:\", lpVolumeNameBuffer, Len(lpVolumeNameBuffer), lpVolumeSerialNumber, _
lpMaximumComponentLength, lpFileSystemFlags, lpFileSystemNameBuffer, _
nFileSystemNameSize

SerialNumber = lpVolumeSerialNumber
End Function

Private Function BreakRegKey(mstrKey As String) As String
'髡夔ㄩ湖汃蛁聊鎢ㄛ遜埻峈茞攫煦?腔橙梓
'mstrKey 峈蛁聊鎢
Dim sKey As String, iKey As Double
Dim lKey As Integer, iLoop As Integer

'裁熬瘍 "-"
While InStr(1, mstrKey, "-") > 0
lKey = InStr(1, mstrKey, "-")
mstrKey = Left(mstrKey, lKey - 1) & Right(mstrKey, Len(mstrKey) - lKey)
Wend

lKey = Len(mstrKey) - 1
'遜埻峈坋輛秶杅趼
For iLoop = lKey To 0 Step -1
sKey = Mid(mstrKey, lKey - iLoop + 1, 1)
If IsNumeric(sKey) Then
iKey = iKey + CInt(sKey) * 16 ^ iLoop
Else
iKey = iKey + (Asc(UCase(sKey)) - 55) * 16 ^ iLoop
End If
Next

sKey = ""
mstrKey = CStr(iKey)
'遜埻峈坋鞠輛秶趼睫揹
Do While CDbl(mstrKey) > 35
iKey = CDbl(mstrKey) / 36

lKey = InStr(1, CStr(iKey), ".")
If lKey > 0 Then
mstrKey = Left(CStr(iKey), lKey - 1)
iKey = Round(CDbl("0." & Right(CStr(iKey), Len(CStr(iKey)) - lKey)) * 36)
Else
mstrKey = CStr(iKey)
iKey = 0
End If

If iKey > 9 Then
sKey = Chr(iKey + 55) & sKey
Else
sKey = iKey & sKey
End If
Loop
If CDbl(mstrKey) > 9 Then
sKey = Chr(CDbl(mstrKey) + 55) & sKey
Else
sKey = mstrKey & sKey
End If

BreakRegKey = sKey
End Function

[Sunron128]

Private Sub Text1_GotFocus()
On Error Resume Next
cmdOrder.Caption = "隅 [&O]"

Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub

Private Function WriteRegKey() As Boolean
Dim intSize As Integer

On Error GoTo Err_Write
WriteRegKey = False
'厘 Win.ini 迡蛁聊鎢
WriteProfileString "SunronSoft", "RegKey", Text1.Text
If Trim(Dir(App.Path + "\key.dat")) <> "" Then Kill App.Path + "\key.dat"
'湖羲絞醴翹狟腔媼輛秶恅璃 Key.Dat 迡蛁聊鎢
Open App.Path + "\key.dat" For Binary Access Write As #1
For intSize = 1 To Len(Trim(Text1.Text))
'妏蚚祑麼堍呾鳳腕蛁聊鎢
Put #1, , (Asc(Mid(Trim(Text1.Text), intSize, 1)) + intSize) Xor Len(Trim(Text1.Text))
Next
Close #1
WriteRegKey = True

Err_Write:
Exit Function
End Function

Private Sub WriteRegDate()
Dim intLength As Integer

On Error GoTo Err_Write
WriteProfileString "SunronSoft", "RegDate", Format(Date, "yyyy-mm-dd")
If Trim(Dir(App.Path + "\key.dat")) <> "" Then Kill App.Path + "\key.dat"
Open App.Path + "\key.dat" For Binary Access Write As #1
For intLength = 1 To 10
Put #1, , Asc(Mid(Format(Date, "yyyy-mm-dd"), intLength, 1)) + intLength Xor 10
Next
Close #1

Err_Write:
Exit Sub
End Sub

[Sunron128]

因為我的系統是繁體,所以檢體中文可能有問題.

[rainstormmaster]

一个可以产生注册码和注册名称的程序，可以利用这个程序建立自己的演示或者共享程序注册部分的功能
http://www.applevb.com/sourcecode/Key%20Generator%20v2.02%20Build%2001%20UPDATE.zip

[Sunron128]

Option Explicit

Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" _
(ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, _
ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _
ByVal nFileSystemNameSize As Long) As Long

Private Declare Function WriteProfileString Lib "kernel32" Alias "WriteProfileStringA" _
(ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Long

Dim sClick As String

Public Property Get ClickInfo() As String
ClickInfo = UCase(sClick)
End Property

Private Sub cmdCancel_Click()
sClick = "Cancel"
Unload Me
End Sub

Private Sub cmdOrder_Click()
If Trim(Text1.Text) = "" Then
Text1.SetFocus
Else
If CheckRegKey(Trim(Text1.Text)) = False Then
MsgBox "注冊碼錯誤，請重新輸入！", vbCritical, "錯誤"
cmdOrder.Caption = "輸入注冊碼 [&O]"
Text1.Text = ""
Else
sClick = "order"
Call WriteRegKey
Unload Me
End If
End If
End Sub

Private Sub cmdTest_Click()
sClick = "Later"
Call WriteRegDate
Unload Me
End Sub

Private Sub Form_Load()

cmdTest.Enabled = blnData

Label3.Caption = GetSerial

Picture1.Height = lblBottom.Top + lblBottom.Height + 120

Me.Width = Label1(7).Width + 240 + 180: Me.Height = Picture1.Height + Frame1.Height + cmdCancel.Height + 600
End Sub

Private Sub Form_Resize()
On Error Resume Next

Me.Top = (Screen.Height - Me.Height) / 2
Me.Left = (Screen.Width - Me.Width) / 2

lblBottom.Left = (Picture1.ScaleWidth - lblBottom.Width) / 2

Frame1.Top = Picture1.Height
Frame1.Left = 0
Frame1.Width = Me.ScaleWidth
Label2(0).Left = (Frame1.Width - Label2(0).Width - Label3.Width) / 2
Label3.Left = Label2(0).Left + Label2(0).Width
Label2(1).Left = Label2(0).Left
Text1.Left = Label3.Left

cmdCancel.Top = Frame1.Top + Frame1.Height + 120
cmdCancel.Left = 120

cmdTest.Top = cmdCancel.Top
cmdTest.Left = Me.ScaleWidth - 120 - cmdTest.Width

cmdOrder.Top = cmdCancel.Top
cmdOrder.Left = cmdTest.Left - cmdOrder.Width - 120
End Sub

Private Function GetSerial() As String
'功能：將十進制數字 oData 轉換為八進制數字
Dim k As Integer
Dim oData As Long

oData = SerialNumber

Do While oData >= 8
k = oData Mod 8
GetSerial = k & GetSerial
oData = oData \ 8
Loop
If oData > 0 Then GetSerial = oData & GetSerial
End Function

Private Function CheckRegKey(vData As String) As Boolean
'功能：檢驗輸入的注冊碼是否正確，True => 正確，False => 失敗
'其中 vData 為注冊碼

If UCase(BreakRegKey(vData)) = UCase(Hex(SerialNumber)) Then
CheckRegKey = True
Else
CheckRegKey = False
End If
Quit_Check:
Exit Function
End Function

Private Function SerialNumber() As Long
'功能：根據硬盤分區信息獲得注冊信息(主要是Ｃ分區)
Dim lpVolumeNameBuffer As String * 128
Dim lpVolumeSerialNumber As Long
Dim lpMaximumComponentLength As Long
Dim lpFileSystemFlags As Long
Dim lpFileSystemNameBuffer As String
Dim nFileSystemNameSize As Long

GetVolumeInformation "C:\", lpVolumeNameBuffer, Len(lpVolumeNameBuffer), lpVolumeSerialNumber, _
lpMaximumComponentLength, lpFileSystemFlags, lpFileSystemNameBuffer, _
nFileSystemNameSize

SerialNumber = lpVolumeSerialNumber
End Function

[Sunron128]

Private Function BreakRegKey(mstrKey As String) As String
'功能：打散注冊碼，還原為硬盤分區Ｃ的卷標
'mstrKey 為注冊碼
Dim sKey As String, iKey As Double
Dim lKey As Integer, iLoop As Integer

'去掉減號 "-"
While InStr(1, mstrKey, "-") > 0
lKey = InStr(1, mstrKey, "-")
mstrKey = Left(mstrKey, lKey - 1) & Right(mstrKey, Len(mstrKey) - lKey)
Wend

lKey = Len(mstrKey) - 1
'還原為十進制數字
For iLoop = lKey To 0 Step -1
sKey = Mid(mstrKey, lKey - iLoop + 1, 1)
If IsNumeric(sKey) Then
iKey = iKey + CInt(sKey) * 16 ^ iLoop
Else
iKey = iKey + (Asc(UCase(sKey)) - 55) * 16 ^ iLoop
End If
Next

sKey = ""
mstrKey = CStr(iKey)
'還原為十六進制字符串
Do While CDbl(mstrKey) > 35
iKey = CDbl(mstrKey) / 36

lKey = InStr(1, CStr(iKey), ".")
If lKey > 0 Then
mstrKey = Left(CStr(iKey), lKey - 1)
iKey = Round(CDbl("0." & Right(CStr(iKey), Len(CStr(iKey)) - lKey)) * 36)
Else
mstrKey = CStr(iKey)
iKey = 0
End If

If iKey > 9 Then
sKey = Chr(iKey + 55) & sKey
Else
sKey = iKey & sKey
End If
Loop
If CDbl(mstrKey) > 9 Then
sKey = Chr(CDbl(mstrKey) + 55) & sKey
Else
sKey = mstrKey & sKey
End If

BreakRegKey = sKey
End Function

Private Sub Text1_GotFocus()
On Error Resume Next
cmdOrder.Caption = "確定 [&O]"

Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub

Private Function WriteRegKey() As Boolean
Dim intSize As Integer

On Error GoTo Err_Write
WriteRegKey = False
'往 Win.ini 寫入注冊碼
WriteProfileString "SunronSoft", "RegKey", Text1.Text
If Trim(Dir(App.Path + "\key.dat")) <> "" Then Kill App.Path + "\key.dat"
'打開當前目錄下的二進制文件 Key.Dat 寫入注冊碼
Open App.Path + "\key.dat" For Binary Access Write As #1
For intSize = 1 To Len(Trim(Text1.Text))
'使用異或運算獲得注冊碼
Put #1, , (Asc(Mid(Trim(Text1.Text), intSize, 1)) + intSize) Xor Len(Trim(Text1.Text))
Next
Close #1
WriteRegKey = True

Err_Write:
Exit Function
End Function

Private Sub WriteRegDate()
Dim intLength As Integer

On Error GoTo Err_Write
WriteProfileString "SunronSoft", "RegDate", Format(Date, "yyyy-mm-dd")
If Trim(Dir(App.Path + "\key.dat")) <> "" Then Kill App.Path + "\key.dat"
Open App.Path + "\key.dat" For Binary Access Write As #1
For intLength = 1 To 10
Put #1, , Asc(Mid(Format(Date, "yyyy-mm-dd"), intLength, 1)) + intLength Xor 10
Next
Close #1

Err_Write:
Exit Sub
End Sub

[hxy1982]

软件是个人智慧的结晶，凝结了自己的血汗。好不容易编写了一个属于自己的软件，希望让别人共享自己的成果，希望别人能记住自己的大名，更希望别人能对自己的软件提出宝贵意见，同时也希望使自己可以方便地提供最新版本的软件给对自己的软件十分关心的用户，当然也要防止盗版（因为我们反对盗版）。这一切都可以用用户注册的方式解决。
谈到注册，便立即联想到注册码，但如何生成注册码，对于软件的设计者是一个十分关键的问题。首先，注册码需要有随机性，即注册码的生成每一次都不一样。其次，注册码需要有特定性，即注册码对于同一用户是一样的或是功能相同的。再次，注册码要有保密性，即不易被他人查到并破解。基于注册码的这种特点，首先就需要有一种合理的设计思路。
笔者所用的是一种明码——密匙——暗码的加密思路。具体说来：当加密时，先取一字符串作为明码（原码），再另取一字符串作密匙，利用某种算法（如常用的伪随机数加密算法）将这两段字符串进行变换及运算，从而获得另一字符串（暗码）,再将暗码和密匙用文件保存起来，这样就不怕别人偷看了;当解密时，将密匙和暗码利用另一种解密算法进行变换和运算，还原得到明码。
这种方法的关键在于利用密匙和暗码能还原唯一的明码，而对于不同的用户应该有不同的明码和密匙，且密匙必须是唯一的（对于同一用户）。如果以上几点无法满足，将无法生成有效的注册码，切记切记！！！
下面用以上思路来设计我们自己的注册码：
首先，选择原码。当然选择注册的用户的用户名（最好是英文）来做注册码的原码，是一个很好的办法，推荐用英文的理由是：英文字符串比中文字符串在运算中容易控制，且不易出错；其次，选择密匙，按照密匙对于不同用户是不同且唯一的原则，我强烈建议选择硬盘的序列号作为密匙。因为从理论上讲一个硬盘的序列号是唯一的，而且不同分区的序列号也不相同。所以，我用硬盘上的C驱动器分区的序列号来做密匙。因为C区好像每台电脑上都有（什么？你没有？我倒！！！）；再次，就是选择暗码了。当然了，暗码应该是由你利用以上思路做成的注册器来生成，并作为注册码寄给用户的啦^－^，有关注册器的设计待会儿再说。
理解了以上的注册码生成的思想后，下面就利用Micosoft 的Visual Basic6.0来完成这项设计工作。需要利用几个Windows的API函数：GetVolumeInformation用以获得硬盘的序列号、GetPrivateProfileString、WritePrivateProfileString用来读写INI文件。对于以上三个API函数的使用不作介绍了,现将其声明如下：
Private Declare Function GetVolumeInformation Lib ″kernel32″ Alias ″GetVolumeInformationA″ (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long Private Declare Function GetPrivateProfileString Lib ″kernel32″ Alias ″GetPrivateProfileStringA″ (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib ″kernel32″ Alias ″WritePrivateProfileStringA″ (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
以上这些声明放在窗体的“通用”中即可。程序窗体的结构图大致见图1：
程序的代码如下：
通用图1的代码：
注释：定义ini文件的文件变量
Dim n As Integer
Dim registry As String ＊ 255
Dim inifilename As String
窗体中的代码：
注释：取得硬盘的序列号的函数
Function GetSerialNumber(strDrive As String) As Long
Dim SerialNum As Long 注释：定义序列号
Dim Res As Long
Dim Temp1 As String
Dim Temp2 As String
Temp1 = String＄(255, Chr＄(0))
Temp2 = String＄(255, Chr＄(0))
注释：调用windows的API函数来获得硬盘序列号
Res = GetVolumeInformation(strDrive, Temp1,
Len(Temp1), SerialNum, 0, 0, Temp2, Len(Temp2))
GetSerialNumber = SerialNum
End Function
Private Sub Command1_Click()
Text3.Text = GetSerialNumber(″c:\″) 注释：取C分区的硬盘序列号
Dim test As New password 注释：定义新的加密类
Dim r_string As String
Dim temp As String
Dim registry_string As String
registry_string = Text3.Text
注释：操作读写ini文件的API函数
Call WritePrivateProfileString(″mouselock″, ″registry″, registry_string, inifileName)
r_string = Text2.Text
temp = test.crypt(″D″, registry_string, r_string)
If Text1.Text = ″″ Then
MsgBox ″必须输入用户名！″, , ″注册″
End
End If
If temp <> (Text1.Text ＋ ″i″) Then 注释：设置区分码
MsgBox ″你应该找作者注册，共享软件凝聚着作者的血和汗.″, , ″注册″
Else
MsgBox ″谢谢使用本软件！″, , ″注册″
Dim registry_string1 As String
registry_string1 = ″tttt″ 注释：加入注册的标记并保存于ini文件中，可以自己设定
注释：调用Windows的API函数来读写ini文件
Call WritePrivateProfileString(″mouselock″, ″reg″, registry_string1, inifileName)
Form1.Show 注释：调用自己的应用程序
Unload Me 注释：关闭注册程序
End If
Text3.Visible = True
Label4.Visible = True
Label5.Visible = True
Label6.Visible = True
End Sub
Private Sub Command2_Click()
Form1.Show 注释：运行你的共享软件主程序
Unload Me 注释：关闭注册程序
End Sub
Private Sub Form_Load()
Form2.Caption = ″Microsoft Visual Basic6.0″ 注释：此处可以改为你的共享软件名
Text3.Visible = False
Label4.Visible = False
Label5.Visible = False
Label6.Visible = False
End Sub
还需要加一个password的类模块，在其中利用的是伪随机数的加密算法来完成加密和解密转换，因涉及到算法，其原理不再详述，仅列其代码如下：

[hxy1982]

Option Explicit
Function crypt(Action As String, Key As String, Src As String) As String
Dim Count As Integer, KeyPos As Integer, KeyLen As Integer, SrcAsc As Integer, dest As String, offset As Integer, TmpSrcAsc, SrcPos
KeyLen = Len(Key)
If Action = ″E″ Then
Randomize
offset = (Rnd ＊ 10000 Mod 255) ＋ 1
dest = Hex＄(offset)
If Len(dest) = 1 Then
dest = ″0″ ＋ dest
End If
For SrcPos = 1 To Len(Src)
SrcAsc = (Asc(Mid＄(Src, SrcPos, 1)) ＋ offset) Mod 255
If KeyPos < KeyLen Then KeyPos = KeyPos ＋ 1 Else KeyPos = 1
SrcAsc = SrcAsc Xor Asc(Mid＄(Key, KeyPos, 1))
dest = dest ＋ Format＄(Hex＄(SrcAsc), ″@@″)
offset = SrcAsc
Next
ElseIf Action = ″D″ Then
offset = Val(″＆H″ ＋ Left＄(Src, 2))
For SrcPos = 3 To Len(Src) Step 2
SrcAsc = Val(″＆H″ ＋ Trim(Mid＄(Src, SrcPos, 2)))
If KeyPos < KeyLen Then KeyPos = KeyPos ＋ 1 Else KeyPos = 1
TmpSrcAsc = SrcAsc Xor Asc(Mid＄(Key, KeyPos, 1))
If TmpSrcAsc <= offset Then
TmpSrcAsc = 255 ＋ TmpSrcAsc － offset
Else
TmpSrcAsc = TmpSrcAsc － offset
End If
dest = dest ＋ Chr(TmpSrcAsc)
offset = SrcAsc
Next
End If
crypt = dest
End Function
好啦，按F5运行你的注册程序，在点击了“注册”按钮后就出现如图2所示的窗体：
还需添加一个ini文件到程序的相对目录下，且字段如下：
[mouselock]
registry=757931525
reg=
好了，一个软件的注册的部分基本完工了，你可以自己设置“运行”按钮中的的代码来控制未注册用户的使用权限，如：使用次数、使用天数、以及用户注册的要求（当然我们都喜欢免费共享软件）等等。当然也可以不加以限制，只是在每次运行软件时会弹出一个注册窗体而已，就如著名的软件ACDSee一样。
还有一点须加以注意：在窗体代码中，有一行代码如下：
If temp <> (Text1.Text ＋ ″i″) Then 注释：设置区分码
它是用来设置区分码的，因为这个程序的加密算法并不是像微软的加密算法那样无人可知，它不过是一种普通的加密算法，但加上了区分码后它的加密性能便提高了许多，如同锁上加锁一样。分区码“″i″”可以由自己随意去添加，这样即使别人知道了你的算法也无法破译你的注册码，因为整个加密过程已经由：（明码＋密匙）→暗码，变为：（明码＋区分码＋密匙）→暗码；而解密过程也相应的由：（暗码＋密匙）→明码，变为：（暗码＋密匙）→(明码＋区分码)。
当然，你也可以对区分码来一个加密，不过这样一层层的加密下去是永无止境的，还是适可为止的好。
注册程序搞定后当然还需要一个注册器啦，用来向你的用户提供注册码嘛！其设计的窗体结构如图3：
在窗体和“生成”按钮中添加如下代码：
Private Sub Command1_Click()
Dim ppp As New password 注释：定义一个型的类
注释：定义明码、暗码、密匙、及区分码
Dim D_string As String
Dim E_string As String
Dim Qf_string As String
Dim MC_string As String
D_string = Text1.Text
Qf_string = Text2.Text
MC_string = Text3.Text
注释：加密
If Text2.Text = ″″ Then
E_string = ppp.crypt(″E″, MC－string, D_string)
Else
D_string = D_string ＋ Qf_string
E_string = ppp.crypt(″E″, MC_string, D_string)
End If
Text4.Text = E_string
End Sub
Private Sub Form_Load()
Form1.Caption = ″注册器″
Text1.Text = ″″
Text2.Text = ″″
Text3.Text = ″″
Text4.Text = ″″
End Sub
当然，还需要加一个“password”的类模块了，就如前述一样，在此不再累述。
当你的用户给你寄过来他的用户名和他的硬盘序列号后，将用户名和序列号依次输入注册器中，再填入你自己的区分码后，按“生成”钮便可得到相对应的注册码了，回寄给你的用户，享受成功的快感吧。
到此为止，我们就完成了注册码的制作的全过程，希望各位高手指正。
以上程序均在Win98及Visual Basic6.0的环境下和Windows2000及 Visual Basic6.0的环境下运行通过。
（武汉 闵锐 蒋锦霞）

[高高兴兴的晶晶]

mark