VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)

VB爱好者乐园(VBGood)

 找回密码
 立即注册
搜索
查看: 12869|回复: 43

[首发原创]边干边写之四——刚写的一个注册机(开源)

[复制链接]
 楼主| 发表于 2007-9-7 18:24:11 | 显示全部楼层 |阅读模式
.
    最近连续接了几个项目,不久都陆续要验收了,可是版权保护成了最让我头痛的问题。
    于是连续搞了几天,弄出个通用的注册机来,几分钟前刚弄好,新鲜出炉,热的~

    这东西最大的优点是只有一个窗体和一个模块,在主程序里加一条:

    Register.CheckReg

    就万事大吉了!
    而且在整个用户程序中所用开销极小,API调用也尽最大可能减到了最少(如不需要硬盘序列号验证还能再少一条)。
   
    不敢独享,连源码一起贴出来让大家批批。

----------声明----------------
    附图中界面上显示的内容完全由使用者定义,不需要保留任何有关我的内容(实际上你的程序里引用它的时候很多信息已经自动变成你的工程属性里的内容了)。
    界面上的“联系方式”在窗体源码中第一个函数内随意修改,可多可少,可有可无,注册机运行时界面将按你提供的信息自动改变大小和显示内容(这也是写这个程序比较费力的地方之一)。
    窗体源码中有一个函数是专门用来调整显示内容的,请使用者不要随意删减界面上的Label控件,而是使用程序代码中的指定区域更改。
    用户只要通过修改密钥就可以实现个性化的加密,而与其他使用此注册机的用户不相冲突。

-----------插几句---------------
趁发的时间还再来加几句话:
    这个东西的好处是用户信息随意自定,加密钥匙随意修改,加密参数随意组合,加密要素随意扩展。
    演示程序中使用的是网卡的MAC,同时还保留了硬盘ID的提取功能,来可以由用户自己添加其他的标志提取功能,并可以随意选择一种或几种做为加密种子。
    至于安全性,如果感觉不理想可以再加个壳。算法本身是不太容易逆运算的。这个算法借鉴了一点微软屏保口令的加密方法,但没用异或运算,又增加了几次移位和变长替换,密钥长度也扩展了不少。
    但任何锁头都不是绝对安全的。我本人也搞过Crack,个人认为,只要你的程序还运行在别人的内存里,存储在别人的硬盘上,就肯定有被破解的可能。问题只是破解者的水平有高有低了。
    我的观点是:用自己的锁,锁自己的门,让别人撬去吧!
    好了废话说得不少了,本次修改留言结束。有意见请跟贴。

[ 本帖最后由 DreamonII 于 2008-12-30 09:47 编辑 ]

LP-Register1.23.rar

46.42 KB, 下载次数: 846

点评

用getvbres可以看到里面的LocalKey,如果有RegisterKey,不是可以算出了?  发表于 2014-5-5 13:51

评分

参与人数 5威望 +68 人气 +1 收起 理由
艾达 + 1 + 1 精品文章
410023425 + 50 精品文章 发布源码 原创精品
54jb + 5 谢谢 共享~ 加分~~
zhangxl0451 + 2 精品文章
bbadsl + 10 发布源码

查看全部评分

 楼主| 发表于 2007-9-7 18:28:37 | 显示全部楼层
顺便灌点水:

[源码]

测试窗体Form1.frm:
Private Sub Form_Load()
    Register.CheckReg     '主程序中只需加入此行代码即可实现注册功能
End Sub


注册机客户端窗体 frmRegister.frm:
'*************************************************************************
'**模块名称:Register 窗体源码
'**项目名称:LP-Register 简易注册机(随软件发布部分)
'**版权信息:<LI-PMF.> 版权所有2007 - 2008(C)
'**作    者:SPP
'**创建日期:2007-01-26 17:12:14
'**修 改 人:SPP
'**修改日期:2007-09-05 18:00:00
'**功能描述:此窗体用于软件发布后的注册码验证(软件授权)
'**声    明:本程序为开源软件,可随意修改及传播。
'**          但如需使用本程序源码,请酌情保留出处及原作者信息。
'**主    页:http://www.DreamonII.cn/
'**版    本:V1.1.2
'**
'**使用方法:1、在程序中添加窗体Register和模块modRegister;
'**          2、在主窗体 Form_Load() 事件或 Sub_Main() 中添加下述语句:
'**             Register.CheckReg
'**
'*************************************************************************

Dim varTimes As Integer             '计数器,用于检查出错次数
Dim UserInfo(1 To 12) As String     '定义用户信息数组

Private Sub Form_Initialize()   '窗体初始化,请根据注释按需修改信息!!
    '******请按需要修改下列设置,注意控制长度以免显示不完整*****
    varRegKey = "RegistInfo"                                            '序列号在注册表中的子键,可以不改
    varRegValue = "RegistKey"                                           '序列号在注册表中的值键,可以不改
   
    '******必填项,请按需修改内容*******************************
    UserInfo(1) = "SPP"                                                 '软件作者
    UserInfo(2) = "Windows 98/2000/XP以上操作系统"                      '适用平台
   
    '******可选项,请按需修改,无对应信息可以留空***************
    UserInfo(7) = "http://www.DreamonII.cn/"                            '主页,没有可以留空
    UserInfo(8) = "li-Q_Q@163.com"                                      '邮箱,没有可以留空
    UserInfo(9) = "20587039"                                            'QQ号码,没有可以留空
    UserInfo(10) = "XXXX-XXXXXXXX"                                      '电话号码,没有可以留空
    UserInfo(11) = "13XXXXXXXXX"                                        '手机号码,没有可以留空
   
    '******可选内容留空测试,请取消不需要显示的内容前的注释*******
    'UserInfo(7) = ""                                                    '主页留空测试
    'UserInfo(8) = ""                                                    '邮箱留空测试
    'UserInfo(9) = ""                                                    'QQ号码留空测试
    UserInfo(10) = ""                                                   '电话号码留空测试
    UserInfo(11) = ""                                                   '手机号码留空测试
   
    '******请按注释在“工程属性”中进行下列设置(尽量不要直接修改下面代码)******
    UserInfo(3) = App.ProductName                                       '请在“产品名”中设置
    UserInfo(4) = "V " & App.Major & "." & App.Minor & App.Revision     '请在“主版本”、“次版本”和“修正”中设置
    UserInfo(5) = App.CompanyName                                       '请在“公司名”中设置
    UserInfo(6) = App.LegalCopyright                                    '请在“合法版权”中设置
   
    funInit '按用户信息进行界面调整
End Sub

'*************************************************************************
'**函 数 名:CheckReg
'**输    入:无
'**输    出:(Boolean)
'**功能描述:公共接口,用于调用注册机
'**作    者:SPP
'**创建日期:2007-01-26 17:52:10
'**修 改 人:SPP
'**修改日期:2007-09-05 18:00:00
'**版    本:V1.1.2
'**使用方法:见模块说明
'*************************************************************************
Public Function CheckReg() As Boolean
    On Error GoTo lopErr '打开错误陷阱
    Dim vResult As Boolean
    vResult = False

    Dim vSN As String
    Dim vI As Integer

    vSN = funGetSNFromReg()
   
    vResult = funCheckSN(vSN)    '检查是否已注册

    If vResult Then     '已注册则
        Unload Me       '正常启动
    Else                '否则
        Dim vFrm As Form
        For Each vFrm In Forms          '从所有窗口中
            If vFrm.hWnd <> hWnd Then   '除注册窗口
                Unload vFrm             '全部关闭
            End If
        Next vFrm
        Set vFrm = Nothing
        
        vReg = MsgBox("您使用的软件尚未注册,请向软件作者申请序列号。" & vbCrLf & "是否现在输入序列号?", vbYesNo Or vbInformation, "版权提示")
        If vReg = vbYes Then  '马上注册则
            txt_Request = funCreateQN("", "-")
            Show              '显示注册窗口
            txt_SN.SetFocus
        Else                  '不注册则
            funExit           '结束程序
        End If
    End If
   
    CheckReg = vResult
    Exit Function
lopErr:
    CheckReg = vResult
    Unload Me
End Function

'按照用户设置的信息调整注册界面
Private Function funInit()
    Height = 4260
    lbl_Author.Caption = UserInfo(1)
    lbl_OS.Caption = UserInfo(2)
    lbl_AppName.Caption = UserInfo(3)
    lbl_Version.Caption = UserInfo(4)
    lbl_Company.Caption = UserInfo(5)
    lbl_Copyright.Caption = UserInfo(6)
   
    If UserInfo(7) <> "" Then lbl_OtherInfo(0) = Format("主页:" & UserInfo(7), "!" & String(44, "@"))
    If UserInfo(8) <> "" Then lbl_OtherInfo(1) = Format("邮箱:" & UserInfo(8), "!" & String(29, "@"))
    If UserInfo(9) <> "" Then lbl_OtherInfo(1) = lbl_OtherInfo(1) & Format("QQ:" & UserInfo(9), String(15, "@"))
    If UserInfo(10) <> "" Then lbl_OtherInfo(2) = Format("电话:" & UserInfo(10), "!" & String(24, "@"))
    If UserInfo(11) <> "" Then lbl_OtherInfo(2) = lbl_OtherInfo(2) & Format("手机:" & UserInfo(11), String(18, "@"))
   
    lin_Connect.Visible = False
    For varTimes = 0 To lbl_OtherInfo.Count - 1
        lbl_OtherInfo(varTimes) = Trim(lbl_OtherInfo(varTimes))
        If lbl_OtherInfo(varTimes) <> "" Then
            lbl_OtherInfo(varTimes).Top = Height - 350
            Height = Height + lbl_OtherInfo(varTimes).Height
        Else
            lbl_OtherInfo(varTimes).Visible = False
        End If
        lin_Connect.Visible = lin_Connect.Visible Or lbl_OtherInfo(varTimes).Visible
    Next varTimes
   
    If lin_Connect.Visible Then
        Height = Height + 100
    End If
    lbl_OSTitle.Left = lbl_OS.Left - lbl_OSTitle.Width - 50
    lbl_Version.Left = lbl_AppName.Left + lbl_AppName.Width + 100
   
    '******其他初始化*******************************************
    varTimes = 0    '计数复位
End Function

'退出程序(显示提示信息并确保系统结束运行)
Public Function funExit(Optional Registed As Boolean = False) As Integer
    On Error GoTo lopErr        '打开错误陷阱
    Dim vResult As Integer      '定义返回值
    vResult = 0
   
    'vResult = 1 / 0       '错误陷阱测试
   
    '**          在此加入退出程序时要执行的清理操作
   
    If vResult = vbOK Then
        End '结束程序
    End If
   
    funExit = vResult   '取消退出则
    Exit Function       '函数返回异常代码
   
lopErr:     '若出错则
    funExit = Err.Number    '返回出错代码
    MsgBox "程序退出时发生错误,错误代码:" & Err.Number & ",错误描述:" & Err.Description, vbOKOnly, "程序退出时出错"
    End
End Function

'注册流程控制代码
Public Function funCheckReg()
    Dim vSN As String
    Dim vTemp As String
    Dim vI As Integer
    Dim vReg As VbMsgBoxResult
   
    Dim vCheck As Boolean
   
    vSN = Trim$(Replace$(txt_SN, Chr$(13), ""))
    vCheck = funCheckSN(vSN)

    If vCheck Then
        If funPutSNToReg(vSN) Then
            MsgBox "注册成功,感谢您选用本软件。" & vbCrLf & "重新启动软件便可以正常使用。", vbOKOnly, "恭喜"
        Else
            MsgBox "在向注册表写入注册码时发生异常" & vbCrLf & "请关闭一些防火墙后重新尝试注册。。", vbOKOnly, "注册失败"
            
        End If
        Unload Me
    ElseIf varTimes < 3 And vReg <> vbNo Then
        vReg = MsgBox("无效的序列号,请向软件作者申请合法的序列号。" & vbCrLf & "是否重新输入序列号?", vbYesNo, "序列号不正确")
        varTimes = varTimes + 1
        With txt_SN
            .SelStart = 0
            .SelLength = Len(.Text)
            .SetFocus
        End With
    Else
        MsgBox "注册失败,请向软件作者申请合法的序列号。", vbOKOnly, "注册失败"
        Unload Me
    End If
End Function

'*****其它界面元素事件响应*****
Private Sub cmd_Cancel_Click()
    Unload Me
End Sub

Private Sub cmd_Reg_Click()
    funCheckReg
End Sub

Private Sub Form_Unload(Cancel As Integer)
    funExit
End Sub

Private Sub txt_SN_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        txt_SN = Trim$(Replace$(txt_SN, Chr$(13), ""))
        funCheckReg txt_SN
    End If
End Sub
(待续)

[ 本帖最后由 DreamonII 于 2007-9-7 20:09 编辑 ]

评分

参与人数 1威望 +3 收起 理由
ty20me + 3

查看全部评分

回复 支持 反对

使用道具 举报

发表于 2007-9-7 18:29:25 | 显示全部楼层
不错,值得学习.加分支持开源

[ 本帖最后由 bbadsl 于 2007-9-7 18:31 编辑 ]
回复 支持 反对

使用道具 举报

 楼主| 发表于 2007-9-7 18:39:59 | 显示全部楼层
刚编辑了一下顶楼,现在继续发源码:

模块modRegister.bas

Attribute VB_Name = "modRegister"
'*************************************************************************
'**模块名称:modRegister 模块源码
'**项目名称:LP-Register 简易注册机(随软件发布部分)
'**版权信息:<LI-PMF.> 版权所有2007 - 2008(C)
'**作    者:SPP
'**创建日期:2007-01-26 17:12:14
'**修 改 人:SPP
'**修改日期:2007-09-05 18:00:00
'**功能描述:此模块用于软件发布后的注册码验证(软件授权)
'**声    明:本程序为开源软件,可随意修改及传播。
'**          但如需使用本程序源码,请酌情保留出处及原作者信息。
'**主    页:http://www.DreamonII.cn/
'**版    本:V1.0.0
'*************************************************************************

Const MAX_ADAPTER_NAME_LENGTH = 260
Const MAX_ADAPTER_ADDRESS_LENGTH = 8
Const MAX_ADAPTER_DESCRIPTION_LENGTH = 132

Type IP_ADDR_STRING
    Next As Long
    IpAddress As String * 16
    IpMask As String * 16
    Context As Long
End Type

Type IP_ADAPTER_INFO
    Next As Long
    ComboIndex As Long
    AdapterName As String * MAX_ADAPTER_NAME_LENGTH
    Description As String * MAX_ADAPTER_DESCRIPTION_LENGTH
    AddressLength As Long
    Address(MAX_ADAPTER_ADDRESS_LENGTH - 1) As Byte
    Index As Long
    Type1 As Long
    DhcpEnabled As Long
    CurrentIpAddress As Long
    IpAddressList As IP_ADDR_STRING
    GatewayList As IP_ADDR_STRING
    DhcpServer As IP_ADDR_STRING
    HaveWins As Boolean
    PrimaryWinsServer As IP_ADDR_STRING
    SecondaryWinsServer As IP_ADDR_STRING
    LeaseObtained As Long
    LeaseExpires As Long
End Type

'**若不使用硬盘序列号加密法则可删除下4条语句
Type DISK_VOLUME
    Volume As String
    Serial As Long
End Type

Declare Function GetNetworkParams Lib "IPHlpApi" (FixedInfo As Any, pOutBufLen As Long) As Long
Declare Function GetAdaptersInfo Lib "IPHlpApi" (IpAdapterInfo As Any, pOutBufLen As Long) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

'**若不使用硬盘序列号加密法则可删除下1条语句
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

'**********************************************************************************
'**    密钥,如果你看它觉得眼熟,那就对了。数据可以自己改,但要与解密程序一致
'**    提示:可以用本程序附送的开源软件“密钥生成器”来建立自己的密钥
Const LocalKey = "570B575A873DF6C88FA27C73FBB3FF1EC44E0C36D93275BD74E68010C7BEEB2D" & _
    "5E87B5919D4D473A54719BA04A77A5E1804858851FFC62766CE4727CB1BE1170" & _
    "A750B728DBE2A89B26FE188D891223F52051C9B42EDDF0D10141521B3F35B1A6" & _
    "78DA805274504D40587D355E1DC7BFADFA9DC3393B2A74119932955F83790012" & _
    "04496562DEEB6A7C2F2146471AEB9B2E116F6B27AA25027B67FB4E5E01BD43F9" & _
    "9FC0A98E1BB84364BD4080ACD4910CBBE90D15C29E14FF429FD0D16BDF36BC8E" & _
    "7DC58109800A2B5C682C26A28E2D479AA7A9E47D4C3B9DBB850463BA4F279016" & _
    "D35A30275036388763FA6DAB8DD39E1C7D884C4E18CD01F97ECD379F96E423C5" & _
    "F3D4FB1CE07FDC3A020E98BCF5E83657B1FE52A925FEAF618C6D923D0791AAFE" & _
    "2377252C54F93DB8698BFB4A299F63BF962F59B0C9229B371519B7FBC78357D5" & _
    "8686D38BF0199D36EDC7BB785E2D6968605E96C8357E39BE5D25EBFA2A0D8F9F" & _
    "7137679EF7F232E7B1E42C99B8D57CA544D14C15A035AD0B86C5517F64345690" & _
    "36DC1867BEE85E20295771D39BDBE0BA95DAB0DC7CAB3B81F53C5ECEC86B101B" & _
    "EB9A186C582F36256924FE893A83D9DC86AE155FCE153655DFC0252C7BD60135" & _
    "E3B5BBBF2BFC1F39B5BFD8EFDA029B4F6D71BFC4EA96C4DA67A3EBDBC1B96D42" & _
    "628126A669923B71524C5229BEAB6A565E87D37D03924835E12A0201FE697795"
'**********************************************************************************

Public varRegKey        As String
Public varRegValue      As String

Public Function funGetMAC() As String   '取得网卡物理地址
    '****************************************************
    '**此函数引用VBGood论坛,感谢weiyi75 (二哥)提供源码!
    '****************************************************
   
    On Error GoTo lopErr '打开错误陷阱
    Dim vResult As String
    vResult = ""
   
    Dim i As Integer, FixedInfoSize&, AdapterInfoSize&
    Dim PhysicalAddress  As String
    Dim AdapterInfo As IP_ADAPTER_INFO
    Dim AdapterInfoBuffer() As IP_ADAPTER_INFO
    Dim pAdapt As Long

    GetNetworkParams ByVal 0&, FixedInfoSize        '获得网络参数
    ReDim FixedInfoBuffer(FixedInfoSize - 1)        '建立网络参数信息缓冲区
    GetAdaptersInfo ByVal 0&, AdapterInfoSize       '获取适配器信息
    ReDim AdapterInfoBuffer(AdapterInfoSize - 1)    '建立适配器信息缓冲区
   
    GetAdaptersInfo AdapterInfoBuffer(0), AdapterInfoSize
   
    CopyMemory AdapterInfo, AdapterInfoBuffer(0), Len(AdapterInfo)  '拷贝AdapterInfo结构
    pAdapt = AdapterInfo.Next

    Do      '这里在原程序基础上做了点改动
        For i = 0 To AdapterInfo.AddressLength - 1
            PhysicalAddress = PhysicalAddress & Format$(Hex$(AdapterInfo.Address(i)), "00")
            If i < AdapterInfo.AddressLength - 1 Then
                PhysicalAddress = PhysicalAddress & "-"
            End If
        Next

        vResult = vResult & " " & PhysicalAddress
        PhysicalAddress = ""
        pAdapt = AdapterInfo.Next       '查找下一个网卡
        
        If pAdapt <> 0 Then
            CopyMemory AdapterInfo, ByVal pAdapt, Len(AdapterInfo)
        End If
    Loop While pAdapt <> 0   '将判断条件移到了后面
   
    funGetMAC = vResult
    Exit Function
lopErr:
    funGetMAC = vResult
End Function

'** 取得硬盘序列号
'** 本版程序中并未使用此功能,为实现加密手段多样化
'** 源码中特保留该函数以便用户自行选择加密种子
'** 如果不需要此功能,可自行删除此函数
'** 并同时删除相关的类型定义和API调用声明

Public Function funGetDiskID(vDrive As String) As DISK_VOLUME
    Dim SerialNum As Long
    Dim Res As Long
    Dim Temp1 As String
    Dim Temp2 As String
    Dim vLen As Integer

    Temp1 = String$(255, Chr$(0))
    Temp2 = String$(255, Chr$(0))
    Res = GetVolumeInformation(vDrive, Temp1, Len(Temp1), SerialNum, 0, 0, Temp2, Len(Temp2))
    vLen = InStr(1, Temp1, Chr$(0))
    funGetDiskID.Serial = SerialNum
    funGetDiskID.Volume = Left$(Temp1, vLen - 1)
End Function

(没发完,待续)
回复 支持 反对

使用道具 举报

 楼主| 发表于 2007-9-7 18:43:31 | 显示全部楼层
(继续)

'*************************************************************************
'**函 数 名:funEncode
'**输    入:vStr, vStep, vOffset, vSize
'**输    出:String
'**功能描述:变长移位替换编码,对注册码加密
'**作    者:SPP
'**创建日期:2007-01-26 17:52:10
'**修 改 人:SPP
'**修改日期:2007-09-05 18:00:00
'**版    本:V1.1.2
'**使用方法: 参数 vStr 是要进行编码的字符串(加密种子)
'**           参数 vStep 是替换时的步进因子
'**           参数 vOffset 是替换时的偏移值
'**           参数 vSize 是每个字符被替换成的长度
'**           编码时通过修改这些参数可实现单一密钥产生多种加密组合,以增加破解难度。
'*************************************************************************
Public Function funEncode(vStr As String, _
                            Optional vStep As Integer = 1, _
                            Optional vOffset As Integer = 0, _
                            Optional vSize As Integer = 2) As String '对一个字符串进行乱序替换编码
                           
    On Error GoTo lopErr
   
    Dim vResult As String
    Dim vI As Integer
    Dim vLen As Integer
    Dim vChar As String
    Dim vTmp As String
    Dim vKey As String
   
    vResult = ""
    vTmp = Replace(Trim(UCase(vStr)), "-", "")
   
    vLen = Len(vTmp)
   
    If vStep < 1 Then
        vStep = 1
    ElseIf vStep > 4 Then
        vStep = 4
    End If
   
    '** 限制关键参数的取值范围 **
    If vSize < 1 Then vSize = 1
    If vSize > 5 Then vSize = 5
    If vOffset < 0 Then vOffset = 0
    If vOffset > vLen / 2 Then vOffset = vLen / 2
   
    '**限制输入字符串的长度
    If vLen < 1 Then
        funEncode = ""
        Exit Function
    ElseIf vLen > Len(LocalKey) / vStep Then
        vLen = Int(Len(LocalKey) / vStep)
    End If
   
    vChar = Left(vTmp, 1)
    For vI = 1 To vLen  '循环替代加密
        vChar = Mid(vTmp, vI, 1)
        vKey = Mid(LocalKey, (Asc(vChar) + vI) * vStep + vOffset, vSize) '通过替换加密,运算的目的是使规律更复杂
        vResult = vResult & vKey
    Next vI
   
    vResult = Trim(vResult)

    funEncode = vResult
    Exit Function
lopErr:
    funEncode = vResult '鲁棒算法,出错仍然返回残串。测试鲁棒性可试把 vLen 设置为1000,函数仍有字串返回
End Function

'生成需求号
Public Function funCreateQN(Optional vStr As String = "", Optional vSpt As String = "") As String
    On Error GoTo lopErr
    Dim vResult As String
    Dim vI As Integer
    Dim vTmp As String
    Dim vSum As Long
    Dim vAdd As String

    vTmp = Trim(UCase(vStr))
   
    If vTmp = "" Then
        vTmp = funGetMAC '如未指定加密种子,则以网卡ID为种子进行加密
    End If
   
    vTmp = funEncode(vTmp, 1) '一次替换
    vTmp = funEncode(vTmp, 3, 137, 3) '变长替换,替换的目的实际上是为了隐蔽加密种子
   
    vSum = 0
    vTmp = Left(vTmp, Len(vTmp) - Len(vTmp) Mod 5)  '丢弃末尾不足5位的部分
    For vI = 1 To Len(vTmp)
        vResult = vResult & Mid(vTmp, vI, 1)
        If vI Mod 5 = 0 Then
            vResult = vResult & vSpt
        End If
        vSum = vSum + Asc(Mid(vTmp, vI, 1))
    Next vI

    vAdd = Hex$(vSum)   '产生附加码
    vAdd = funEncode(vAdd, 4)   '附加码可用于较验是否合法需求号
   
    vResult = Trim(vResult) & Trim(vAdd)    '组合需求码
   
    funCreateQN = vResult
    Exit Function
lopErr:
    funCreateQN = vResult '鲁棒算法,出错仍然返回残串
End Function

'**********************************************************************************
'** 生成序列号
'** 此函数内所使用的参数必须与解密软件中funCreateSN 函数完全一致!
'** 如非特别必要请勿自行更改!
'**********************************************************************************
Public Function funCheckSN(SN As String) As Boolean    '检查序列号
    On Error GoTo lopErr '打开错误陷阱
   
    Dim vResult As Boolean
    Dim vQN As String
    Dim vSN As String
    vResult = False
   
    vQN = funCreateQN()
   
    '** 注意:以下对funEncode函数的调用中参数可根据需要设置
    '** 但设置不当可能产生负面效果
    '** 比如生成的字符串过长或过短等
    '** 用户可调整最后一个参数以改变字符串长度
    '** 每调用一次该函数则调整范围为1-4位原字符串长度
   
    vSN = funEncode(vQN, 1, 13, 1)
    vSN = funEncode(vSN, 2, 79, 1)
    'Debug.Print funEncode(vSN, 3, 190, 1)   '此行仅用于调试
   
    If UCase(Trim(SN)) = funEncode(vSN, 3, 190, 1) Then  '变步长三次替换取得SN
        vResult = True
    End If
   
    'Debug.Print vResult    '此行仅用于调试
   
    funCheckSN = vResult
    Exit Function
    '----------------
lopErr:
    funCheckSN = False
End Function

'从注册表中取出注册码
Function funGetSNFromReg() As String
    On Error GoTo lopErr
    Dim vResult As String
   
    vResult = GetSetting(App.EXEName, varRegKey, varRegValue)
    funGetSNFromReg = vResult
    Exit Function
lopErr:
    funGetSNFromReg = ""
End Function

'向注册表中写入注册码
Function funPutSNToReg(vSN As String) As Boolean
    On Error GoTo lopErr
    Dim vResult As Boolean
   
    vResult = False
   
    If Trim(vSN) <> "" Then
        SaveSetting App.EXEName, varRegKey, varRegValue, Trim(vSN)
        vResult = True
    End If
   
    funPutSNToReg = vResult
    Exit Function
   
lopErr:
    funPutSNToReg = False
End Function

'从注册表中删除注册码
Function funRemoveSNFromReg() As Boolean
    On Error GoTo lopErr
    Dim vResult As Boolean
    vResult = False
   
    DeleteSetting App.EXEName, varRegKey, varRegValue
    vResult = True
    funRemoveSNFromReg = vResult
    Exit Function
   
lopErr:
    funRemoveSNFromReg = False
End Function

(客户端结束,待续)
回复 支持 反对

使用道具 举报

 楼主| 发表于 2007-9-7 18:51:01 | 显示全部楼层
Register窗口的代码看上去挺长,其实界面控制占了挺大一部分,真正有用的3/4左右。

其他的就简单了
解密模块不用考虑太多的问题,直接用加密一样的算法就行(从加密函数改名来的)

界面控制部分略,只写核心代码:

Attribute VB_Name = "modRegisterKey"
'**********************************************************************************
'**    密钥,解密程序必须与客户程序使用相同的密钥
'**    提示:可以用本程序附送的开源软件“密钥生成器”来建立自己的密钥
Const LocalKey = "570B575A873DF6C88FA27C73FBB3FF1EC44E0C36D93275BD74E68010C7BEEB2D" & _
    "5E87B5919D4D473A54719BA04A77A5E1804858851FFC62766CE4727CB1BE1170" & _
    "A750B728DBE2A89B26FE188D891223F52051C9B42EDDF0D10141521B3F35B1A6" & _
    "78DA805274504D40587D355E1DC7BFADFA9DC3393B2A74119932955F83790012" & _
    "04496562DEEB6A7C2F2146471AEB9B2E116F6B27AA25027B67FB4E5E01BD43F9" & _
    "9FC0A98E1BB84364BD4080ACD4910CBBE90D15C29E14FF429FD0D16BDF36BC8E" & _
    "7DC58109800A2B5C682C26A28E2D479AA7A9E47D4C3B9DBB850463BA4F279016" & _
    "D35A30275036388763FA6DAB8DD39E1C7D884C4E18CD01F97ECD379F96E423C5" & _
    "F3D4FB1CE07FDC3A020E98BCF5E83657B1FE52A925FEAF618C6D923D0791AAFE" & _
    "2377252C54F93DB8698BFB4A299F63BF962F59B0C9229B371519B7FBC78357D5" & _
    "8686D38BF0199D36EDC7BB785E2D6968605E96C8357E39BE5D25EBFA2A0D8F9F" & _
    "7137679EF7F232E7B1E42C99B8D57CA544D14C15A035AD0B86C5517F64345690" & _
    "36DC1867BEE85E20295771D39BDBE0BA95DAB0DC7CAB3B81F53C5ECEC86B101B" & _
    "EB9A186C582F36256924FE893A83D9DC86AE155FCE153655DFC0252C7BD60135" & _
    "E3B5BBBF2BFC1F39B5BFD8EFDA029B4F6D71BFC4EA96C4DA67A3EBDBC1B96D42" & _
    "628126A669923B71524C5229BEAB6A565E87D37D03924835E12A0201FE697795"
'**********************************************************************************

'**********************************************************************************
'** 生成序列号
'** 此函数内所使用的参数必须与客户软件中funCheckSN函数完全一致!
'** 如非特别必要请勿自行更改!
'**********************************************************************************
Public Function funCreateSN(QN As String) As String
    On Error GoTo lopErr '打开错误陷阱
   
    Dim vResult As String
    Dim vQN As String
   
    vResult = ""
   
    vQN = Trim(QN)
   
    '** 注意:以下对funEncode函数的调用中参数可根据需要设置
    '** 但设置不当可能产生负面效果
    '** 比如生成的字符串过长或过短等
    '** 用户可调整最后一个参数以改变字符串长度
    '** 每调用一次该函数则调整范围为1-4位原字符串长度
   
    vResult = funEncode(vQN, 1, 13, 1)
    vResult = funEncode(vResult, 2, 79, 1)
    vResult = funEncode(vResult, 3, 190, 1)
        
    funCreateSN = vResult
    Exit Function
   
lopErr:
    funCreateSN = ""
End Function

'*************************************************************************
'**函 数 名:funEncode
'**输    入:vStr, vStep, vOffset, vSize
'**输    出:String
'**功能描述:变长移位替换编码,对注册码加密
'**作    者:SPP
'**创建日期:2007-01-26 17:52:10
'**修 改 人:SPP
'**修改日期:2007-09-05 18:00:00
'**版    本:V1.1.2
'**使用方法: 参数 vStr 是要进行编码的字符串(加密种子)
'**           参数 vStep 是替换时的步进因子
'**           参数 vOffset 是替换时的偏移值
'**           参数 vSize 是每个字符被替换成的长度
'**           编码时通过修改这些参数可实现单一密钥产生多种加密组合,以增加破解难度。
'*************************************************************************
Private Function funEncode(vStr As String, _
                            Optional vStep As Integer = 1, _
                            Optional vOffset As Integer = 0, _
                            Optional vSize As Integer = 2) As String '对一个字符串进行乱序替换编码
                           
    On Error GoTo lopErr
   
    Dim vResult As String
    Dim vI As Integer
    Dim vLen As Integer
    Dim vChar As String
    Dim vTmp As String
    Dim vKey As String
   
    vResult = ""
    vTmp = Replace(Trim(UCase(vStr)), "-", "")
   
    vLen = Len(vTmp)
   
    If vStep < 1 Then
        vStep = 1
    ElseIf vStep > 4 Then
        vStep = 4
    End If
   
    '** 限制关键参数的取值范围 **
    If vSize < 1 Then vSize = 1
    If vSize > 5 Then vSize = 5
    If vOffset < 0 Then vOffset = 0
    If vOffset > vLen / 2 Then vOffset = vLen / 2
   
    '**限制输入字符串的长度
    If vLen < 1 Then
        funEncode = ""
        Exit Function
    ElseIf vLen > Len(LocalKey) / vStep Then
        vLen = Int(Len(LocalKey) / vStep)
    End If
   
    vChar = Left(vTmp, 1)
    For vI = 1 To vLen  '循环替代加密
        vChar = Mid(vTmp, vI, 1)
        vKey = Mid(LocalKey, (Asc(vChar) + vI) * vStep + vOffset, vSize) '通过替换加密,运算的目的是使规律更复杂
        vResult = vResult & vKey
    Next vI
   
    vResult = Trim(vResult)

    funEncode = vResult
    Exit Function
lopErr:
    funEncode = vResult '鲁棒算法,出错仍然返回残串。测试鲁棒性可试把 vLen 设置为1000,函数仍有字串返回
End Function

(解密部分完毕)
回复 支持 反对

使用道具 举报

 楼主| 发表于 2007-9-7 19:00:03 | 显示全部楼层
.
    此外,为了不同用户使用时方便生成自己独有的密钥,还附带写了个密钥生成器,用来产生随机的密钥常定义。
    那个早几小时写它的时候已经开了个贴发过了,这里再发
回复 支持 反对

使用道具 举报

 楼主| 发表于 2007-9-7 19:18:05 | 显示全部楼层
晕,楼上的贴子坏掉了~~ 编辑时显示全是HTML源码~ 郁闷,重发一次
.
    此外,为了不同用户使用时方便生成自己独有的密钥,还附带写了个密钥生成器,用来产生随机的密钥常定义。
    那个早几小时写它的时候已经开了个贴发过了,这里再发一下:
回复 支持 反对

使用道具 举报

发表于 2007-9-7 20:28:41 | 显示全部楼层
辛苦,论坛有你更精彩!:) :) :)
回复 支持 反对

使用道具 举报

 楼主| 发表于 2007-9-7 21:48:17 | 显示全部楼层
原帖由 DreamonII 于 2007-9-7 18:24 发表
.
    最近连续接了几个项目,不久都陆续要验收了,可是版权保护成了最让我头痛的问题。
    于是连续搞了几天,弄出个通用的注册机来,几分钟前刚弄好,新鲜出炉,热的~

        这东西最大的优点是只有一个窗体和一个模块,在主程序里加一条:

    Register.CheckReg

    就万事大吉了!


……


    对该注册机的使用方法在这里不得不补充几句!

    我在顶楼所说的引用方法只不过是最简单情况下的方法,实际使用中需要再加些判断条件才行。如下:

Private Sub Form_Load()
    If Not Register.CheckReg Then
        Unload Me   '这条很关键!!
        ' 这里也可以用 Exit Sub
        ' 但感觉不如 Unload Me 效果好
    Else
       ……
       这里加入用户原来Form_Load里需要处理的语句!
       ……
    End if
End Sub


    提出这种用法的原因是:
    刚刚在帮坛子里一个朋友的软件加注册机的时候,发现他的程序欢迎窗口中又是定时器又是音频播放,结果导致注册窗口循环启动,程序几乎死锁。因此提醒使用注册机的朋友注意以下几点:
    1、如果启动窗口的Form_Load事件中有其他需要处理的代码,请按上例中的方式将其放入Else分支下!
    2、如果启动窗口中使用了Timer控件,请一定要设置其Enabled属性为假,在Else分支下再设值为真!
    3、如果启动窗口的Form_Unload事件中同样需要处理代码,请加入一个判断语句(这种情况需要借助一个窗口级的的布尔变量来判断,千万不要再Register.CheckReg一次,下面给出示例)!

   使用实例:
   窗体Form1,有一Timer,Load和Unload均有代码,引用注册机方法如下:
   
   Dim vReged As Boolean

   Private Sub Form_Load()
      Timer1.Enabled = False   '如果你在设计时没设Enabled=False,这里一定要先写上这句!
      vReged=Register.CheckReg

      If Not vReged Then
          Unload Me
      Else
          Me.Width= ..........

          ......

          MCI_1.Play.......
      End If
   End Sub
   
   Private Sub Form_Unload()
      If Not vReged Then
         Exit Sub      
      End If

      .....

      '这里是原窗体退出的代码

      ....
   End Sub


   如果使用中发现有任何错误或问题,诚请回贴指出,以便我能随时完善!!多谢!!!

评分

参与人数 1威望 +5 收起 理由
chinatyq + 5 论坛的魅力因你而展现!!

查看全部评分

回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

文字版|手机版|小黑屋|VBGood  

GMT+8, 2019-8-25 23:30

VB爱好者乐园(VBGood)
快速回复 返回顶部 返回列表