如何为VBA应用程序创build产品密钥，防止非法分发软件？

我正在使用Excel VBA应用程序。

我的公司想把它做成一个产品。 这个应用程序只能在一个系统上安装。 有人可以帮我这个。

Answer 1

这只是关于如何确保您的产品仅安装在一个系统上的一个基本示例。

逻辑：

1. 检索硬件ID（例如：硬盘编号，CPU编号等）
2. 您也可以询问用户姓名和电子邮件地址
3. encryption上面的信息生成一个Unique Code （这是在应用程序内完成）
4. 用户向您发送Unique Code （ 通过电子邮件/在线激活/电话 ）
5. 您根据Unique Code向用户发送Activation Id

用于检索HardDisk序列号和CPU编号的代码

将此代码粘贴到类模块中（ 不是我的代码，代码中提到的版权信息 ）

 Private Const VER_PLATFORM_WIN32S = 0 Private Const VER_PLATFORM_WIN32_WINDOWS = 1 Private Const VER_PLATFORM_WIN32_NT = 2 Private Const DFP_RECEIVE_DRIVE_DATA = &H7C088 Private Const FILE_SHARE_READ = &H1 Private Const FILE_SHARE_WRITE = &H2 Private Const GENERIC_READ = &H80000000 Private Const GENERIC_WRITE = &H40000000 Private Const OPEN_EXISTING = 3 Private Const CREATE_NEW = 1 Private Enum HDINFO HD_MODEL_NUMBER HD_SERIAL_NUMBER HD_FIRMWARE_REVISION End Enum Private Type OSVERSIONINFO dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * 128 End Type Private Type IDEREGS bFeaturesReg As Byte bSectorCountReg As Byte bSectorNumberReg As Byte bCylLowReg As Byte bCylHighReg As Byte bDriveHeadReg As Byte bCommandReg As Byte bReserved As Byte End Type Private Type SENDCMDINPARAMS cBufferSize As Long irDriveRegs As IDEREGS bDriveNumber As Byte bReserved(1 To 3) As Byte dwReserved(1 To 4) As Long End Type Private Type DRIVERSTATUS bDriveError As Byte bIDEStatus As Byte bReserved(1 To 2) As Byte dwReserved(1 To 2) As Long End Type Private Type SENDCMDOUTPARAMS cBufferSize As Long DStatus As DRIVERSTATUS bBuffer(1 To 512) As Byte End Type Private Declare Function GetVersionEx _ Lib "kernel32" Alias "GetVersionExA" _ (lpVersionInformation As OSVERSIONINFO) As Long Private Declare Function CreateFile _ Lib "kernel32" Alias "CreateFileA" _ (ByVal lpFileName As String, _ ByVal dwDesiredAccess As Long, _ ByVal dwShareMode As Long, _ ByVal lpSecurityAttributes As Long, _ ByVal dwCreationDisposition As Long, _ ByVal dwFlagsAndAttributes As Long, _ ByVal hTemplateFile As Long) As Long Private Declare Function CloseHandle _ Lib "kernel32" _ (ByVal hObject As Long) As Long Private Declare Function DeviceIoControl _ Lib "kernel32" _ (ByVal hDevice As Long, _ ByVal dwIoControlCode As Long, _ lpInBuffer As Any, _ ByVal nInBufferSize As Long, _ lpOutBuffer As Any, _ ByVal nOutBufferSize As Long, _ lpBytesReturned As Long, _ ByVal lpOverlapped As Long) As Long Private Declare Sub ZeroMemory _ Lib "kernel32" Alias "RtlZeroMemory" _ (dest As Any, _ ByVal numBytes As Long) Private Declare Sub CopyMemory _ Lib "kernel32" Alias "RtlMoveMemory" _ (Destination As Any, _ Source As Any, _ ByVal Length As Long) Private Declare Function GetLastError _ Lib "kernel32" () As Long Private mvarCurrentDrive As Byte Private mvarPlatform As String Public Property Get Copyright() As String Copyright = "HDSN Vrs. 1.00, (C) Antonio Giuliana, 2001-2003" End Property Public Function GetModelNumber() As String GetModelNumber = CmnGetHDData(HD_MODEL_NUMBER) End Function Public Function GetSerialNumber() As String GetSerialNumber = CmnGetHDData(HD_SERIAL_NUMBER) End Function Public Function GetFirmwareRevision() As String GetFirmwareRevision = CmnGetHDData(HD_FIRMWARE_REVISION) End Function Public Property Let CurrentDrive(ByVal vData As Byte) If vData < 0 Or vData > 3 Then Err.Raise 10000, , "Illegal drive number" ' IDE drive 0..3 End If mvarCurrentDrive = vData End Property Public Property Get CurrentDrive() As Byte CurrentDrive = mvarCurrentDrive End Property Public Property Get Platform() As String Platform = mvarPlatform End Property Private Sub Class_Initialize() Dim OS As OSVERSIONINFO OS.dwOSVersionInfoSize = Len(OS) Call GetVersionEx(OS) mvarPlatform = "Unk" Select Case OS.dwPlatformId Case Is = VER_PLATFORM_WIN32S mvarPlatform = "32S" Case Is = VER_PLATFORM_WIN32_WINDOWS If OS.dwMinorVersion = 0 Then mvarPlatform = "W95" Else mvarPlatform = "W98" End If Case Is = VER_PLATFORM_WIN32_NT mvarPlatform = "WNT" End Select End Sub Private Function CmnGetHDData(hdi As HDINFO) As String Dim bin As SENDCMDINPARAMS Dim bout As SENDCMDOUTPARAMS Dim hdh As Long Dim br As Long Dim ix As Long Dim hddfr As Long Dim hddln As Long Dim s As String Select Case hdi Case HD_MODEL_NUMBER hddfr = 55 hddln = 40 Case HD_SERIAL_NUMBER hddfr = 21 hddln = 20 Case HD_FIRMWARE_REVISION hddfr = 47 hddln = 8 Case Else Err.Raise 10001, "Illegal HD Data type" End Select Select Case mvarPlatform Case "WNT" hdh = CreateFile("\\.\PhysicalDrive" & mvarCurrentDrive, _ GENERIC_READ + GENERIC_WRITE, FILE_SHARE_READ + FILE_SHARE_WRITE, _ 0, OPEN_EXISTING, 0, 0) Case "W95", "W98" hdh = CreateFile("\\.\Smartvsd", _ 0, 0, 0, CREATE_NEW, 0, 0) Case Else Err.Raise 10002, , "Illegal platform (only WNT, W98 or W95)" End Select If hdh = 0 Then Err.Raise 10003, , "Error on CreateFile" End If ZeroMemory bin, Len(bin) ZeroMemory bout, Len(bout) With bin .bDriveNumber = mvarCurrentDrive .cBufferSize = 512 With .irDriveRegs If (mvarCurrentDrive And 1) Then .bDriveHeadReg = &HB0 Else .bDriveHeadReg = &HA0 End If .bCommandReg = &HEC .bSectorCountReg = 1 .bSectorNumberReg = 1 End With End With DeviceIoControl hdh, DFP_RECEIVE_DRIVE_DATA, _ bin, Len(bin), bout, Len(bout), br, 0 s = "" For ix = hddfr To hddfr + hddln - 1 Step 2 If bout.bBuffer(ix + 1) = 0 Then Exit For s = s & Chr(bout.bBuffer(ix + 1)) If bout.bBuffer(ix) = 0 Then Exit For s = s & Chr(bout.bBuffer(ix)) Next ix CloseHandle hdh CmnGetHDData = Trim(s) End Function 

你可以使用它来调用它

 '~~> Get the CPU No CPU = GetWmiDeviceSingleValue("Win32_Processor", "ProcessorID") '~~> Get the Hard Disk No Dim h As HDSN Set h = New HDSN With h .CurrentDrive = 0 HDNo = .GetSerialNumber End With Set h = Nothing 

获得此信息后，可以将其与名字，姓氏和电子邮件地址合并以创buildstring。 例如

 strg = Trim(FirstName) & Chr(1) & Trim(LastName) & Chr(1) & _ Trim(EmailAddress) & Chr(1) & Trim(CPU) & Chr(1) & Trim(HDNo) 

一旦你有string，你可以encryption它。 这是encryption它的另一个基本的例子。 你可以select任何你想要的encryptiontypes

 For i = 1 To Len(strg) RandomNo = (Rnd * 100) tmp = tmp & Hex((Asc(Mid(strg, i, 1)) Xor RandomNo)) Next 

上面的tmp保存encryption的string。

一旦你收到这个string，你将不得不解码，并创build一个Activation Id 。 您的应用程序应该能够接受Activation Id 。 您还可以select将此信息存储在registry中或Dat文件中。

一个简单的注册窗口可能看起来像这样。

希望这会让你开始！ 🙂

IMP ：虽然你可以locking你的VBA项目，但绝对不是黑客certificate。 你可能想要探索VSTO来创build这样做的DLL。