如何防止免費分發商業Excel電子表格

Question

我不確定在不同的SE網站（超級用戶？）下這是否更合適。

我想建立並銷售一個複雜的宏驅動驅動的電子表格到某個垂直。我主要關心在垂直方向上的客戶之間的免費/未經授權的分發。

我可以看到市場上有一些可能能夠做我想做的事的不起眼的產品，但是我找到的少數評論並不有利。然而

一個供應商列出了免費發放可以通過規避：通過簡單地使用加密的密碼

或者

• 使用密鑰生成器來創建許可證代碼
• 使用在線激活功能

是否有人知道任何指導方針/框架（任何語言）爲我建立我自己的解決方案來實現這一點，即需要許可證代碼或在線激活？

如果這通常是一個艱難的努力，是否有任何人推薦的商業產品？

我也在考慮實現這一點所涉及的複雜性可能會促使我改爲構建一個小型SaaS應用程序。我最好走那條路？

Answer 1

在不可能在密鑰生成器中生成的宏中創建您自己的特殊唯一許可證密鑰。例如，添加您自己的前綴。如果用戶在聯機數據庫中使用它，則可以存儲它。這個解決方案的垮臺是用戶必須連接到外部互聯網。

然後通過下面的鎖定用鑰匙該模塊：

爲了保護您的代碼，打開Excel工作簿，並轉到工具>宏> Visual Basic編輯器（按Alt + F11）。現在，從VBE內部進入工具> VBAProject屬性，然後單擊保護頁面選項卡，然後選中「查看鎖定項目」，然後輸入密碼並再次確認。完成此操作後，您必須保存，關閉&重新打開工作簿以使保護生效。

Answer 2

我創建了一個Excel工作表，如果每月訂閱付款失敗，我可以遠程刪除訪問權限。這裏是如何做到這一點：

1. 創建和HTML表格，並把它上傳到你的網站

2. 在您的Excel文檔到數據標籤，並從網絡獲取 - 導入你的表成片狀稱爲「驗證」 - 確保你的表有3列。序列號位於第一列，第二位用戶的描述以及第三列頂部的錯誤消息。此處存儲的錯誤消息是每個未註冊的用戶將看到的內容。第一個序列號應出現在工作表驗證的單元格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 

另一個模塊中我做

而且確定互聯網已連接。如果沒有互聯網，那麼工作表關閉。如果你不這樣做，那麼如果有人從互聯網上斷開你的連續劇不會被加載。

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 

應該這樣做....