我不确定这是否更适合在其他SE网站（如超级用户）发布？
我想构建并销售一个复杂的宏驱动电子表格，针对特定垂直行业。我主要关注该垂直行业中客户之间的免费/未经授权的分发问题。
我可以看到市场上有一些比较模糊的产品可能能够满足我的需求，但是我找到的少数评论都不是很好。
然而，一个供应商列出了可以通过以下方式规避免费分发：
有没有人知道任何指导方针/框架（任何语言），让我构建自己的解决方案来实现这一点，即需要许可证代码或在线激活？
如果这通常是一个困难的事情，有没有任何商业产品可以推荐？
我也在考虑实现这个问题所涉及的复杂性，是否会将我推向构建一个小型SaaS应用程序。那我最好选择哪种方法呢？
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
在另一个模块中，我确保互联网连接。如果没有互联网，则该工作表将关闭。如果您不这样做，那么如果有人断开互联网连接，您的序列号将无法加载。
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
Scriptlet.TypeLib可用于创建GUID，您可以将其用作许可代码来分发它们（当然，跟踪这些GUID是必须的）。希望这有所帮助。 ;) - WGS