vba實現工具的序列號驗證框架
對於密碼破譯方面筆者不太懂，之前對於各種序列號的激活也有些臆測，自己根據想法做了個序列號驗證的小框架，以後做的工具也可以用之保護一下下。。。
主要思路是：用戶打開小工具後，系統檢測是否已激活，如果未激活，系統給出一個隨機數字碼（每次重新打開之後會變化），用戶根據隨機碼向提供者索要對應激活碼用於激活
關於是否激活的判斷：筆者這裏做法是，正常激活後會在註冊表裏寫對應值，如果檢測到這個值就不會再次提醒用戶激活
1、隨機碼的生成，根據隨機數Rnd來生成滿足條件的一串數字，直接上代碼
Sub SetRanId()
Randomize
Dim RanId As Long
SetRndId:
Rnd * 10000000 + _
Rnd * 1000000 + _
Rnd * 100000 + _
Rnd * 10000 + _
Rnd * 1000 + _
Rnd * 100 + _
Rnd * 10
If RanId < 10000000 Or RanId > 99999999 Then GoTo SetRndId
FrmCheckId.TextBox1.Value = RanId
End Sub
效果如下圖：
2、對應激活序列號的校驗
其實這裏筆者做的只是依據隨機碼，通過一組規則生成序列號，直接上代碼，可以看出校驗規則其實我已經做了封裝，在這個類中：MyMethod.KUSY
‘序列號設置
Sub CheckTheId()
On Error GoTo Err_CheckId
Dim rId As Long
Dim sId As String
Dim MyFnc
rId = CLng(FrmCheckId.TextBox1.Value)
sId = FrmCheckId.TextBox2.Value
Set MyFnc = CreateObject("MyMethod.KUSY")
If Len(sId) >= 8 Then
If MyFnc.CheckId(sId, rId) Then
MsgBox "已激活！", vbInformation
idFlg = True
Call MyFnc.RegChk(idFlg, RegFlg)
Unload FrmCheckId
End If
End If
Set MyFnc = Nothing
Exit Sub
Err_CheckId:
MsgBox Err.Description, vbCritical
End Sub
3、關於封裝類KUSY的方法也貼了出來
（1）檢查註冊表是否已有鍵值，如果沒有，寫入設定好的鍵值，如果有，返回True，說明工具已激活，不再進行序列號的激活處理
‘註冊表檢查以及設置
Function RegChk(ByVal idFlg As Boolean, ByRef RegFlg As Boolean) As Boolean
On Error GoTo Err_RegChk
Dim s As String
RegChk = False
Set WSH = CreateObject("WSCRIPT.SHELL")
s = WSH.RegRead(RegPK & PjName & "\" & RegX & "\" & KeyName)
Err_RegChk:
If s = KeyVal Then
RegFlg = True
RegChk = True
Else
RegFlg = False
RegChk = False
End If
If RegFlg = False And idFlg = True Then
WSH.RegWrite RegPK & PjName & "\" & RegX & "\" & KeyName, KeyVal
RegChk = True
End If
End Function
（2）序列號生成規則，如下，可以看到筆者隨意設置了一組規則，這個就是需要填寫的激活碼了
‘序列號取得
Function GetMyId(ByVal rId As Long) As String
Dim id(1 To 8) As Long
Dim flg As String
Dim result As String
For i = 1 To 8
id(i) = Mid(CStr(rId), i, 1)
Select Case i
Case 1
id(i) = id(i) * 10 Mod 9
Case 2
id(i) = id(i) * 10 Mod 7
Case 3
id(i) = id(i) * id(i)
If id(i) > 10 Then id(i) = (id(i) - 10) Mod 9
Case 4
If id(i) > id(i - 1) Then id(i) = id(i) - id(i - 1)
Case 5
id(i) = id(i) * 8 Mod 9
Case 6
id(i) = id(i) * 20 Mod 9
Case 7
If id(i) > 5 Then
id(i) = id(i) / 2
Else
id(i) = id(i) + 1
End If
Case 8
id(i) = Left(CStr(id(i) * 9), 1)
End Select
Next
If id(3) + id(5) > 3 Then flg = "k"
If id(3) + id(5) > 8 Then flg = "u"
If id(3) + id(5) > 13 Then flg = "s"
If id(3) + id(5) > 17 Then flg = "y"
For Each s In id
result = result & s
Next
‘result = Replace(Join(id, " "), " ", "")
GetMyId = result & flg
End Function
（3）校驗用戶輸入函數，直接返回布爾值，為什麽要寫這個而不是直接在vba代碼中判斷用戶輸入的序列號是否等於規則生成的呢？因為如果不用下面這個函數，用戶直接在vbe中debug就可以獲取到規則生成的序列號了
Function CheckId(ByVal sId As String, ByVal rId As Long) As Boolean
If sId = GetMyId(rId) Then
CheckId = True
Else
CheckId = False
End If
End Function
4、對於序列號生成規則的代碼，可以獨立出來，用於生成序列號值，把這個值給用戶來激活
如下圖：
（1）管理員
（2）用戶
5、其他的工具以後就可以使用這個序列號驗證框架了，使用方法如下
（1）打開時加載dll文件，關閉時移除
Private Sub Workbook_Open()
On Error GoTo Err_WorkOpen
Application.Visible = False
‘Dll加載
If Dir(ThisWorkbook.Path & "\MyMethod.dll") <> "" Then
Shell "Regsvr32 /s " & Chr(34) & ThisWorkbook.Path & "\MyMethod.dll" & Chr(34)
Else
MsgBox "DLL文件不存在，請確認！", vbCritical
Exit Sub
End If
FrmCheckId.Show
Application.Visible = True
Exit Sub
Err_WorkOpen:
MsgBox Err.Description, vbCritical
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Shell "Regsvr32 /s /u " & Chr(34) & ThisWorkbook.Path & "\MyMethod.dll" & Chr(34)
End Sub
（2）工具中添加UserForm
初始化時調用KUSY.RegChk，代碼如下：
Private Sub UserForm_Initialize()
On Error GoTo Err_Init
Dim idFlg As Boolean
Dim Myfnc
HideFlg = False
Set Myfnc = CreateObject("MyMethod.KUSY")
‘檢查註冊表
If Myfnc.RegChk(idFlg, RegFlg) = True Then
HideFlg = True
GoTo EndFrm
End If
With FrmCheckId
.Caption = "序列號驗證--V1.1"
.BackColor = ColorConstants.vbWhite
.BorderStyle = fmBorderStyleNone
.Width = 200
.Height = 120
End With
TextBox1.Enabled = False
Call SetRanId
Set Myfnc = Nothing
EndFrm:
Exit Sub
Err_Init:
MsgBox Err.Description, vbCritical
End Sub
vba實現工具的序列號驗證框架