自动注册功能已经完成了,现在贴出来这部分!!! (3千字)
Private Sub Auto_reg(RegNum As String)Const ERROR_SUCCESS = 0&
Const REG_SZ = 1&
Const HKEY_LOCAL_MACHINE = &H80000002
Const READ_CONTROL = &H20000
Const STANDARD_RIGHTS_READ = READ_CONTROL
Const KEY_QUERY_VALUE = &H1&
Const KEY_ENUMERATE_SUB_KEYS = &H8&
Const KEY_NOTIFY = &H10&
Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY
Dim hKey As Long
Dim SubKey, strPath As String
Dim lBufferSize As Long
Dim rtn As Long, lBuffer As Long, sBuffer As String
Dim FileNo As Integer
'利用添加与删除程序的信息,来找到SuperCapture的安装目录
SubKey = "Software\Microsoft\Windows\CurrentVersion\Uninstall\SuperCapture 3.02_is1"
rtn = RegOpenKeyEx(HKEY_LOCAL_MACHINE, SubKey, 0, KEY_READ, hKey) '打开一个主键
If rtn = ERROR_SUCCESS Then 'if the key could be opened then
sBuffer = Space(255) 'make a buffer
lBufferSize = Len(sBuffer)
rtn = RegQueryValueEx(hKey, "Inno Setup: App Path", 0, REG_SZ, sBuffer, lBufferSize) 'get the value from the registry
If rtn = ERROR_SUCCESS Then 'if the value could be retreived then
rtn = RegCloseKey(hKey) 'close the key
sBuffer = Trim(sBuffer)
strPath = Left(sBuffer, Len(sBuffer) - 1)
Else
MsgBox "找到到SuperCapture的安装目录,不能自动注册!"
End If
Else
MsgBox "你安装的SuperCapture可能版本不对,不能自动注册!"
End If
FileNo = FreeFile(0)
Open strPath + "\scconfig30.cfg" For Binary Access Write As FileNo
Seek #FileNo, &H19D
Put #FileNo, , RegNum
Close FileNo
MsgBox "注册完成,现在程序会打开SuperCatpure验证一下!请确定SuperCatpure现在没有运行!!"
Shell strPath + "\SuperCapture.exe", vbNormalFocus
End Sub
Private Sub Exit_Click()
End
End Sub
Private Sub Go_Click()
Dim n, al As Integer
Dim ebx As Long
Dim Sn(1 To 16) As Long '生成的注册码
Dim StrSn As String '用于把注册码变成字符串
StrSn = ""
ebx = 0
If Mid(UserNum.Text, 5, 1) <> "-" Or Mid(UserNum.Text, 10, 1) <> "-" Or Mid(UserNum.Text, 15, 1) <> "-" Then
MsgBox "你的用户号不正确,请重新输入!!", vbCritical
UserNum.Text = ""
Exit Sub
End If
If Len(UserNum.Text) = &H13 Then
CreatEbp1 UserNum.Text '根据用户号生成表1
'表1的后8位依次加0至7,然后再分别平方,累加后存在ebx中
For n = 1 To 8
ebx = ebx + (Ebp1(n) + Ebp1(n + 8) + n - 1) * (Ebp1(n) + Ebp1(n + 8) + n - 1)
Next n
CreatEbp2 '生成表2
'利用表1和表2,根据下列算式得出注册码
For n = 1 To 16
al = (((n * n + Ebp1(n)) * ebx) And &HFF) + Ebp2(n)
al = al Mod &H1A
Sn(n) = al + &H41
StrSn = StrSn + Chr(Sn(n))
Next n
End If
'用“-”把注册码四位一组分开,显示出来
OutNum.Text = Mid(StrSn, 1, 4) + "-" + Mid(StrSn, 5, 4) + "-" + Mid(StrSn, 9, 4) + "-" + Mid(StrSn, 13, 4)
'询问是否自动注册,是,就自动注册;否,就算了。
If (MsgBox("你想让本程序自动注册吗?", vbOKCancel) = vbOK) Then
Auto_reg OutNum.Text
End If
End Sub
