飘云阁

 找回密码
 加入我们

QQ登录

只需一步,快速开始

查看: 3134|回复: 0

[求助] 给Excel 表格加了注册机制,但不会做出相应的注册机求帮助

[复制链接]
  • TA的每日心情
    开心
    2023-4-4 10:28
  • 签到天数: 96 天

    [LV.6]常住居民II

    发表于 2015-11-28 14:38:12 | 显示全部楼层 |阅读模式
    Dim temp
        temp = 1354422520
        Dim MyUserName
        MyUserName = GetSetting(appname:="MyApp", section:="Startup", Key:="User")
        RegValue = GetSetting(appname:="MyApp", section:="Startup", Key:="Reg")
        Dim Reg, Serial1, Serial2 As Long
        Serial1 = Abs(Format(CreateObject("Scripting.FileSystemObject").GetDrive("C:").SerialNumber))
        Serial2 = Abs(Format(CreateObject("Scripting.FileSystemObject").GetDrive("D:").SerialNumber))
        Dim serial
        serial = Serial1 + Serial2
        Dim Head, RegCode As String
        Dim head1, head2

        head1 = Mid(serial, 2, 1)
        head2 = Mid(serial, 6, 1)


       ' head1 = Left(serial, 1)
      '  head2 = Right(serial, 1)
        H1 = Array("H", "I", "J", "M", "O", "A", "B", "Z", "K", "L")
        H2 = Array("P", "G", "N", "T", "R", "E", "V", "D", "S", "J")
        head1 = H1(head1)
        head2 = H2(head2)
        Head = head1 & head2
        Reg = Round(Abs(serial + temp) / 3, 0) + serial
        If RegValue = serial + temp Then
            MsgBox "本文件已由" & MyUserName & "注册成功!请放心使用!  ", vbInformation, "注册信息"
            SaveSetting "MyApp", "Startup", "reg2", 1
            Exit Sub
        End If
        Set Dialog = DialogSheets("DH-Register")
        Dialog.DrawingObjects("T1").Text = serial
        Dialog.EditBoxes("D0").Text = ""
        Dialog.EditBoxes("D1").Text = ""
    Begin:
        DBBoxOK = Dialog.Show
        If Not DBBoxOK Then
            Exit Sub
        End If
        If Dialog.EditBoxes("D0").Text = "" Then
            MsgBox "请输入用户名!  ", vbExclamation, "错误信息"
            GoTo Begin
        End If
        User = Dialog.EditBoxes("D0").Text
        RegCode = Right(Asc(User), 1) & Head & Format$(Hex$(Asc(User)), "@@") & Mid(Reg, 1, 4) & Mid(Asc(User), 2, 1)
        If Dialog.EditBoxes("D1").Text = "zhangtianhe" Then GoTo superadmin
        If Dialog.EditBoxes("D1").Text <> RegCode Then
            MsgBox "请输入正确的注册码!  ", vbExclamation, "错误信息"
            GoTo Begin
        End If
    superadmin:
        Dim reg1, user1
        reg1 = serial + temp
        user1 = User
        SaveSetting "MyApp", "Startup", "Reg", reg1
        SaveSetting "MyApp", "Startup", "User", user1
        MsgBox "恭喜您!已成功注册!  ", vbInformation, "信息"
    End Sub
    PYG19周年生日快乐!
    您需要登录后才可以回帖 登录 | 加入我们

    本版积分规则

    快速回复 返回顶部 返回列表