• 时间:
  • 分类:

1. 前言

在实际的企业信息化交付中，很多开发者依然会使用 Access 作为桌面级应用或者局域网管理系统的快速开发平台。利用 VBA 的强大生态，Access 能够以极低的成本解决中小型企业的核心痛点。

然而，在软件交付或试用阶段，我们经常面临一个棘手的问题：如何保护软件知识产权，防止用户随意拷贝和分发？ 通常我们会将 .accdb 文件编译为 .accde 或 .mde 以隐藏核心源码，但这无法阻止物理文件的直接复制。

本文将解析如何在 Access 项目中引入“一机一码”软授权机制。通过提取目标设备的固有硬件指纹，结合哈希密码学算法，实现业务终端与应用授权的强绑定。

2. 技术原理分析

“一机一码”认证模型的核心在于：硬件唯一性、防逆向伪造、轻量级部署。以下是该机制的技术原理：

阶段核心实现与原理
指纹采集使用 WMI（Windows Management Instrumentation）获取主板 CPU ID 及 C 盘卷序列号。增加“计算机名称”以降低同批次同型号硬件可能带来的碰撞率。
混淆加盐在原始特征码中加入动态“盐值（Salt）”，防止懂技术的用户直接推导原始字符串。这部分通过异或运算隐藏在 VBA 数组中。
哈希降维硬件信息组合后的字符串长且无规律，不适合作为机器码让用户手工复制或抄写。通过 DJB2 哈希算法变体，散列为 16 位紧凑格式（XXXX-XXXX-XXXX-XXXX）。
注册生成根据用户提交的 16 位机器码，加入管理员独占的“私有密钥（Secret Key）”，再次进行哈希运算生成配对的注册码。

3. 核心功能实现（附源码）

3.1 获取硬件指纹

在 VBA 中调用系统的 WMI 服务可以轻易获取硬件属性，这是该机制的基础。这里同时采集 CPU ID 与逻辑磁盘 C 盘序列号。

' 获取CPU标识符 (通过WMI)
Private Function GetCPUId() As String
    On Error GoTo ErrHandler
    Dim objWMI As Object, colItems As Object, objItem As Object

    Set objWMI = GetObject("winmgmts:\\.\root\cimv2")
    Set colItems = objWMI.ExecQuery("Select ProcessorId From Win32_Processor")

    For Each objItem In colItems
        GetCPUId = Trim$(objItem.ProcessorId & "")
        If GetCPUId <> "" Then Exit For
    Next

    If GetCPUId = "" Then GetCPUId = "NOCPUID"
    Exit Function

ErrHandler:
    GetCPUId = "NOCPUID"
End Function

3.2 自定义哈希算法压缩长度

标准 MD5 会产出相对较长的文本，这里我们采用变种的轻量级 Hash 算法（类似 DJB2），利用位运算（And、Xor），将其压制在 16 位十六进制的范围内。

' 核心哈希函数：将长字符串映射为 0~65535 之间的整型哈希值
Private Function Hash16(ByVal s As String, ByVal seed As Long) As Long
    Dim h As Long
    h = seed And &H7FFF&
    
    Dim i As Long
    For i = 1 To Len(s)
        ' 乘以 33 并加上 ASCII 值，使用 &H7FFFFFFF 防止 VBA 长整型溢出
        h = ((h And &HFFFF&) * 33 + Asc(Mid$(s, i, 1))) And &H7FFFFFFF
    Next i

    Hash16 = h And &HFFFF&
End Function

3.3 机器码与注册码的生成分离

“机器码”是给用户侧界面的，“注册码”是需要管理端工具单独生成的。二者在生成路径上的差异点在于核心加密密钥只存在于计算注册码的时候。

' 获取当前机器的机器码 (4组16进制)
Public Function GetMachineCode() As String
    ' 1. 采集硬件信息
    Dim rawInfo As String
    rawInfo = GetCPUId() & "|" & GetDiskSerial() & "|" & Environ("COMPUTERNAME")
    
    ' 2. 加入盐值防推断
    Dim combined As String
    combined = rawInfo & DecodeSalt()
    
    ' 3. 分段 Hash 映射
    Dim h1 As Long, h2 As Long, h3 As Long, h4 As Long
    h1 = Hash16(combined, &H1A3B)
    '...略

    GetMachineCode = Right$("0000" & Hex$(h1), 4) & "-" & Right$("0000" & Hex$(h2), 4) '...略
End Function

管理端由于持有私钥 DecodeKey()，当拿到机器码之后：

' 根据机器码生成对应防伪注册码
Private Function ComputeRegCode(ByVal mcClean As String) As String
    Dim combined As String
    ' 机器码加上私有密钥，进行不对称 Hash
    combined = mcClean & DecodeKey()

    Dim h1 As Long, h2 As Long, h3 As Long, h4 As Long
    h1 = Hash16(combined, &H5183)
    '...略
    
    ' 产出与该机器唯一匹配的授权识别码
    ComputeRegCode = Right$("0000" & Hex$(h1), 4) & "-" & Right$("0000" & Hex$(h2), 4) '...略
End Function

3.4 完整代码

新建一个通用模块，具体代码如下：

Option Compare Database
Option Explicit


' 获取当前机器的机器码
' 格式: XXXX-XXXX-XXXX-XXXX (十六进制)
Public Function GetMachineCode() As String
    Dim rawInfo As String
    rawInfo = GetCPUId() & "|" & GetDiskSerial() & "|" & Environ("COMPUTERNAME")

    Dim salt As String
    salt = DecodeSalt()

    Dim combined As String
    combined = rawInfo & salt

    Dim h1 As Long, h2 As Long, h3 As Long, h4 As Long
    h1 = Hash16(combined, &H1A3B)
    h2 = Hash16(combined, &H2C4D)
    h3 = Hash16(combined, &H3E5F)
    h4 = Hash16(combined, &H4A71)

    GetMachineCode = Right$("0000" & Hex$(h1), 4) & "-" & _
                     Right$("0000" & Hex$(h2), 4) & "-" & _
                     Right$("0000" & Hex$(h3), 4) & "-" & _
                     Right$("0000" & Hex$(h4), 4)
End Function

' 根据机器码生成注册码
Public Function GenerateRegCode(ByVal machineCode As String) As String
    Dim mcClean As String
    mcClean = Replace(UCase$(Trim$(machineCode)), "-", "")

    If Len(mcClean) <> 16 Then
        GenerateRegCode = "错误：机器码格式不正确，应为16位十六进制字符(XXXX-XXXX-XXXX-XXXX)"
        Exit Function
    End If

    GenerateRegCode = ComputeRegCode(mcClean)
End Function

' ==================== 内部实现 ====================

Private Function ComputeRegCode(ByVal mcClean As String) As String
    Dim combined As String
    combined = mcClean & DecodeKey()

    Dim h1 As Long, h2 As Long, h3 As Long, h4 As Long
    h1 = Hash16(combined, &H5183)
    h2 = Hash16(combined, &H6295)
    h3 = Hash16(combined, &H73A7)
    h4 = Hash16(combined, &H4B9)

    ComputeRegCode = Right$("0000" & Hex$(h1), 4) & "-" & _
                     Right$("0000" & Hex$(h2), 4) & "-" & _
                     Right$("0000" & Hex$(h3), 4) & "-" & _
                     Right$("0000" & Hex$(h4), 4)
End Function

Private Function Hash16(ByVal s As String, ByVal seed As Long) As Long
    Dim h As Long
    h = seed And &H7FFF&

    Dim i As Long
    For i = 1 To Len(s)
        h = ((h And &HFFFF&) * 33 + Asc(Mid$(s, i, 1))) And &H7FFFFFFF
    Next i

    Hash16 = h And &HFFFF&
End Function

Private Function DecodeKey() As String
    Dim b() As Variant
    b = Array(116, 12, 70, 120, 12, 81, 30, 108, 12, 92, 77, 12, 75, 127, 13, 15, 13, 10)
    Dim s As String, i As Long
    For i = 0 To UBound(b)
        s = s & Chr$(CLng(b(i)) Xor &H3F)
    Next i
    DecodeKey = s
End Function

' 解码盐值（运行时混淆）
Private Function DecodeSalt() As String
    Dim b() As Variant
    b = Array(23, 25, 27, 104, 106, 104, 99, 121, 8, 63, 61)
    Dim s As String, i As Long
    For i = 0 To UBound(b)
        s = s & Chr$(CLng(b(i)) Xor &H5A)
    Next i
    DecodeSalt = s
End Function

' 获取CPU标识符 (通过WMI)
Private Function GetCPUId() As String
    On Error GoTo ErrHandler
    Dim objWMI As Object
    Dim colItems As Object
    Dim objItem As Object

    Set objWMI = GetObject("winmgmts:\\.\root\cimv2")
    Set colItems = objWMI.ExecQuery("Select ProcessorId From Win32_Processor")

    For Each objItem In colItems
        GetCPUId = Trim$(objItem.ProcessorId & "")
        If GetCPUId <> "" Then Exit For
    Next

    If GetCPUId = "" Then GetCPUId = "NOCPUID"
    Exit Function

ErrHandler:
    GetCPUId = "NOCPUID"
End Function

' 获取C盘卷序列号 (通过WMI)
Private Function GetDiskSerial() As String
    On Error GoTo ErrHandler
    Dim objWMI As Object
    Dim colItems As Object
    Dim objItem As Object

    Set objWMI = GetObject("winmgmts:\\.\root\cimv2")
    Set colItems = objWMI.ExecQuery( _
        "Select VolumeSerialNumber From Win32_LogicalDisk Where DeviceID='C:'")

    For Each objItem In colItems
        GetDiskSerial = Trim$(objItem.VolumeSerialNumber & "")
        If GetDiskSerial <> "" Then Exit For
    Next

    If GetDiskSerial = "" Then GetDiskSerial = "NODISK"
    Exit Function

ErrHandler:
    GetDiskSerial = "NODISK"
End Function

3.5 创建窗体

这里创建一个简单的窗体给大家演示一下，具体窗体如下：

窗体的具体代码，就是调用一下函数：

Private Sub btnGenerateRegCode_Click()
    Me.txtGenerateRegCode = GenerateRegCode(Me.txtMachineCode)
End Sub

Private Sub btnMachineCode_Click()
   Me.txtMachineCode = GetMachineCode()
End Sub

3.6 运行测试

这里给大家看一下，运行效果：

4. 业务落地与使用方法

将上述底层方法封装完毕后，你只需要在 Access 中配置入口宏。

  1. 新建 AutoExec 宏，配置 RunCode 行为指向拦截函数 =CheckRegistration()。
  2. 在该函数内，判断数据表中是否存在正确的授权记录。
  3. 若未授权，则中断主窗体加载，强行弹起注册窗体。
  4. 用户复制屏幕上呈现的机器码发给开发者；开发者在脱机环境调用上述 ComputeRegCode() 函数算出激活码并交付。

5. 进阶内容（静态混淆与反逆向）

任何暴露在客户端的代码都有被逆向的可能，即使是 .accde，VBA P-Code 依然有可能被还原。所以私钥不写明文是基础中的基础。

我们可以运用异或运算（XOR）在内存中动态还原秘钥，提高破解门槛，具体的功能就不再说明了，如果可以，大家可以自行优化。

6. 总结

采用“硬件信息采集 + Hash运算压缩”组合成的这套方案，是给 Access 系统加上商业护城河的一条务实捷径。无需搭建云端激活服务，几段代码就能有效规避 90% 的随意白嫖行为。

如果你正苦于自己辛辛苦苦开发的局域网/单机桌面应用被客户随手 U 盘拷走，不妨把这套机制嵌进你的项目里，花 10 分钟的时间，将纯技术转化成可掌控的生产力。

Access 开发」 专注于 Microsoft Access 开发与企业级应用，提供以下服务：

📚 技术培训

Access VBA 从入门到精通（线上/线下）

Access + SQL Server 企业级开发实战

Access 系统性能优化与架构设计

💼 定制开发

企业 ERP/CRM/进销存等系统开发

旧系统升级与性能优化

🔧 技术支持

代码审查与重构建议

疑难问题远程诊断

一对一技术辅导

联系方式：

公众号后台留言

邮箱：will.miao@edonsoft.com

微信：edonsoft 公众号：access开发

技术改变业务，专注创造价值。

标签: none

添加新评论