マクロで作成したEXCELのファイルにライセンス認証機能を付ける(販売したい)

EXCELのマクロのファイルで一生懸命作成しても、公開してしまったら自由に使われます。

マクロのパスワードだけでは心もとない場合は下記の内容を入力してください。

yOption Explicit
Function GetIPAddress() As String

    Dim NetAdapters, objNic, strIPAddress
    Set NetAdapters = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2") _
                           .ExecQuery("Select * from Win32_NetworkAdapterConfiguration " & _
                           "Where (IPEnabled = TRUE)")

    For Each objNic In NetAdapters '?l?b?g???[?N?A?_?v?^?[??A???????????????
        For Each strIPAddress In objNic.IPAddress 'IP??A???????蓖???????????????
            GetIPAddress = strIPAddress
            Exit For        ' ?P????
        Next
        Exit For        ' ?P????
    Next

End Function
Sub ???????\??()

    Dim username As String, deckey As String
    
    
    username = "ここは自由"
    deckey = "ここがライセンスキー"
    
    
    Dim objIE As InternetExplorer
    Set objIE = New InternetExplorer
    
    On Error Resume Next
    
    objIE.Visible = False
    objIE.Navigate "https://設置するアドレスを記入?user=" & username & "&ipaddr=" & GetIPAddress()
    
    Debug.Print "https://設置するアドレスを記入?user=" & username & "&ipaddr=" & GetIPAddress()
    
    
    Dim shl As Object '?V?F???I?u?W?F?N?g????
    Set shl = CreateObject("Shell.Application")
    
    Dim targetTitle As String '?擾???????E?B???h?E??^?C?g??????
    targetTitle = "key"
    
    Dim win As Object, getFlag As Boolean
    For Each win In shl.Windows '?N??????E?B???h?E???????????
        
        'IE??G?N?X?v???[?????V?F????擾???????IE??????
        If TypeName(win.document) = "HTMLDocument" Then
            If win.document.Title = targetTitle Then
    
                Set objIE = win
                
                getFlag = True '???????擾?????
                Exit For
            End If
        End If
        
    Next
    
    If getFlag = False Then
        MsgBox "?C???^?[?l?b?g????????????????A???????F??????????????B", vbExclamation
        objIE.Quit
        Set objIE = Nothing
        ActiveWorkbook.Saved = True
        ActiveWorkbook.Close
        Exit Sub
    Else
        Debug.Print "Internet access: Success!"
    End If
    
    Dim htmlDoc As HTMLDocument
    Set htmlDoc = objIE.document
    Dim flg As Boolean: flg = False
     
    Dim para As HTMLElementCollection
    
    For Each para In htmlDoc.getElementsByTagName("p")
        Debug.Print para.innerText & "before check"
        If para.innerText = deckey Then
            flg = True
            Exit For
        Else
            Debug.Print para.innerText
            flg = False
        End If
    Next
    
    objIE.Quit
    Set objIE = Nothing
    Set htmlDoc = Nothing
    
    Debug.Print flg
    
    If flg = True Then
        MainForm.Show vbModeless
    Else
     MsgBox "?s??????[?U?[???", vbExclamation
     ActiveWorkbook.Saved = True
     ActiveWorkbook.Close
    End If
    

End Sub

これに加えて、テキストでhymlファイルを作成します。
記載は下記のような感じで。

<html>
<head>
<title>key</title>
</head>
<body><p>認証コードを記入</p>
</body>
</html>

ファイル名は「pass.html」などでいいですし、基本自由です。
サーバーの方にアップして、そこのアドレス先をマクロの方で書き換えてください。

初回起動に関しては、インターネットにつながっていないと認証がされません。
pass.htmlの認証コードを書き換えると以前のものは、マクロが稼働しなくなります。
複数ライセンスコードを入れるなら<p>認証コード</p>を増やして下さい。

まあ、マクロのパスワードを解除して、マクロを書き換えられたら、普通に使えますが、エクセルにライセンス認証機能を付けるとなるとこの辺りが仕様として限界かと・・・・。

せっかく作ったファイルを販売などしたい場合はこのような機能を付けると良いのではないかと思います。

インターネットのライセンスっぽくしたやり方です。
IPアドレス管理の手段もありますが、あえてシンプルに・・・・。
サーバーにアクセスして「pass.html」ログを吸い出せば、アクセス状況を確認も取れます。




にほんブログ村 地域生活(街) 九州ブログ 久留米情報へ
にほんブログ村 ライフスタイルブログ ライフスタイル情報へ