如何防止免费分发商业Excel电子表格
我不确定在不同的SE网站（超级用户？）下这是否更合适。
我想build立并销售一个复杂的macros驱动驱动的电子表格到一定的垂直。 我主要关心在这个垂直客户之间自由/未经授权的分配。
我可以看到市场上有一些晦涩的产品，可能能够做我想做的，但是我能find的less数评论并不令人满意。
然而，一个供应商列出了免费分发可以通过以下方式绕过：
- 使用密钥生成器来创build许可证代码
- 使用在线激活function
- 或者只需使用encryption的密码
有没有人知道任何指导方针/框架（任何语言）为我build立我自己的解决scheme来实现这一点，即需要许可证代码或在线激活？
如果这通常是一个困难的努力，有没有人推荐的商业产品？
我也在想，实现这一点所涉及的复杂性可能会促使我改为build立一个小型的SaaS应用程序。 我最好走那条路？
在一个不太可能在密钥生成器中生成的macros中创build您自己的特殊唯一许可证密钥。 例如，添加您自己的前缀。 如果用户在在线数据库中使用它，则可以进行存储。 这个解决scheme的倒台是用户必须连接到外部的互联网。
然后通过以下键locking该模块：
要保护您的代码，请打开Excel工作簿并转至工具>macros> Visual Basic编辑器（Alt + F11）。 现在，从VBE内部进入工具> VBAProject属性，然后单击保护页面选项卡，然后选中“locking项目查看”，然后input密码，再次确认。 这样做后，您必须保存，closures并重新打开工作簿保护才能生效。
我创build了一个Excel工作表，如果每月订阅付款失败，我可以远程删除访问权限。 这里是如何做到这一点：
-
创buildHTML表格并将其上传到您的网站
-
在您的Excel文档中，转到数据选项卡并select从网站获取 – 将表导入名为“validation”的工作表 – 确保您的表有3列。 序列号位于第一列，第二位用户的描述以及第三列顶部的错误消息。此处存储的错误消息是每个未注册的用户将看到的内容。 第一个序列号应出现在工作表validation的单元格A2中。
在您的Visual Basic编辑器中将此代码粘贴到模块中 – 此代码将基于PC硬盘序列号返回一个8位序列号：
Function HDSerialNumber() As String Dim fsObj As Object Dim drv As Object Set fsObj = CreateObject("Scripting.FileSystemObject") Set drv = fsObj.Drives("C") HDSerialNumber = Left(Hex(drv.SerialNumber), 4) _ & "-" & Right(Hex(drv.SerialNumber), 4) End Function
另外在另一个模块，我确保互联网连接。 如果没有互联网，那么工作表closures。 如果你不这样做，那么如果有人从互联网上断开你的连续剧将不会被加载。
Option Explicit #If VBA7 And Win64 Then Private Declare PtrSafe Function InternetGetConnectedStateEx Lib "wininet.dll" (ByRef lpdwFlags As Long, ByVal lpszConnectionName As String, ByVal dwNameLen As Integer, ByVal dwReserved As Long) As Long #Else Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" (ByRef lpdwFlags As Long, ByVal lpszConnectionName As String, ByVal dwNameLen As Integer, ByVal dwReserved As Long) As Long #End If Function IsInternetConnected() As Boolean Dim strConnType As String, lngReturnStatus As Long, MyScript As String If Application.OperatingSystem Like "*Macintosh*" Then MyScript = "repeat with i from 1 to 2" & vbNewLine MyScript = MyScript & "try" & vbNewLine MyScript = MyScript & "do shell script ""ping -o -t 2 www.apple.com""" & vbNewLine MyScript = MyScript & "set mystatus to 1" & vbNewLine MyScript = MyScript & "exit repeat" & vbNewLine MyScript = MyScript & "on error" & vbNewLine MyScript = MyScript & "If i = 2 Then set mystatus to 0" & vbNewLine MyScript = MyScript & "end try" & vbNewLine MyScript = MyScript & "end repeat" & vbNewLine MyScript = MyScript & "return mystatus" If MacScript(MyScript) Then IsInternetConnected = True Else lngReturnStatus = InternetGetConnectedStateEx(lngReturnStatus, strConnType, 254, 0) If lngReturnStatus = 1 Then IsInternetConnected = True End If End Function
然后在Workbook_Open区域内粘贴这个：
Private Sub Workbook_Open() If IsInternetConnected Then Dim objFSO As Object Dim MyFolder As String Dim sFileName As String Dim iFileNum As Integer Dim sBuf As String Dim trialstartdate As String Dim z As String Dim fsoFSO Set fsoFSO = CreateObject("Scripting.FileSystemObject") 'UNCOMMENT below to SHOW the serials sheet when the workbook is opened ActiveWorkbook.Sheets("Verify").Visible = xlSheetVisible 'UNCOMMENT below to hide the serials sheet when the workbook is opened 'ActiveWorkbook.Sheets("Verify").Visible = xlSheetVeryHidden Refresh_Serials z = 2 'loop here for valid hard drive serial number Do Until IsEmpty(Worksheets("Verify").Cells(z, 1).Value) If Worksheets("Verify").Cells(z, 1).Value = HDSerialNumber Then 'verified and let pass GoTo SerialVerified End If z = z + 1 Loop Dim custommessage As String custommessage = Worksheets("Verify").Cells(2, 3) MsgBox custommessage + " Your serial number is: " + HDSerialNumber Dim wsh1, MyKey1 Set wsh1 = CreateObject("Wscript.Shell") MyKey1 = "%{TAB}" wsh1.SendKeys MyKey1 MsgBox "The Commission Tracker will not open without a valid serial number. It will now close. uncomment this in workbook->open to close the workbook if the serial isn't found" Application.DisplayAlerts = False 'uncomment this to close the workbook if the serial isn't found 'ActiveWorkbook.Close Application.DisplayAlerts = True SerialVerified: ' does the end user agree to not use this tool for mailicous purposes? MsgAgree = MsgBox("Your PC's serial number is " & HDSerialNumber & ". By clicking 'Yes' you agree to use our software as described in our end user agreement. - the URL to your terms here", vbYesNo, "Final Agreement") If MsgAgree = vbNo Then 'close program MsgBox "This program will now close since you do not agree to our end user agreement" Application.DisplayAlerts = False ActiveWorkbook.Close Application.DisplayAlerts = True Else 'continue to open the program End If Else MsgBox "No Network Connection Detected - You must have an internet connection to run the commission tracker." Application.DisplayAlerts = False ActiveWorkbook.Close Application.DisplayAlerts = True End If End Sub
这应该做到这一点….