欢迎来到 嗅灵易学

零基础也能上手的脚本技术课,一对一答疑带你入门

自动注册功能已经完成了,现在贴出来这部分!!! (3千字)

自动注册功能已经完成了,现在贴出来这部分!!! (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

注意:上传附件及图片大小不得大于30M。

⚠️ 版权声明:
本博客所有内容(含教程、源码、工具)仅供个人技术学习与研究交流使用,严禁商用、倒卖、二次分发及非法用途
未经作者书面授权,任何组织或个人不得转载、复制或用于其他平台,违者将追究相关责任。

0 0 0 举报
复制成功