Excel VBAでPC固有の不変情報を取得する方法

2020年6月27日 VBA

ツールを作って有料で配布する場合、コピー対策やライセンスの考慮が不可欠となる。コピーして普通に使えると、お金を払って購入した人からすると、迷惑なことだろう。 安易にばら撒かれたら、「買う価値無し」ってことになる。ツールを作る側からしても、苦労の甲斐がなくなる。

単純にコピーしても使えないようにする対策を考える。一案として、パソコン固有の情報をライセンスIDとしてサーバーに登録し、ツール実行時はライセンスIDでサーバーにアクセスして登録済みか否かのチェックを行うことが考えられる。こうすれば、登録したPCのみ、ツールを使うことができる。PC固有情報に加えてツール（アプリ）の情報を登録すれば、PCごとに使えるツールを決めることも可能だ。

この記事では、Excel VBAでパソコン固有の情報を取得する方法を紹介する。そして、その固有情報として、ハードディスク(HD)のシリアルナンバー(シリアル＃)を採用する。他にも以下が考えられるが、いずれも変わることがある。

・OSのプロダクトID
　→ Windows Updateで勝手に変わることがある。
・コンピュータ名
　→ ユーザーが割と簡単に変更できる。
・MACアドレス
　→ LANカードが交換されると変わる。

MACアドレスについては、HDのシリアル＃と同レベルで変わる頻度が少ないと思うので、これを採用しても良い。HDだって、交換すればシリアル＃は変わってしまうが、とりあえずここではシリアル＃で話を進める。

HDのシリアル＃を取得するサンプルコード(VBA)を以下に示す。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

Public Function getSKey()
    Dim DiskSet As SWbemObjectSet
    Dim Disk As SWbemObject
    Dim Locator As SWbemLocator
    Dim Service As SWbemServices
    Dim MesStr As String
    Dim ret

    Set Locator = New WbemScripting.SWbemLocator
    Set Service = Locator.ConnectServer

    Set DiskSet = Service.ExecQuery("Select * From Win32_DiskDrive")

    ret = ""
    For Each Disk In DiskSet
        If Disk.MediaType <> "Removable Media" Then
            ret = Replace(Disk.Caption, " ", "") & Replace(Disk.SerialNumber, " ", "")
            Exit For
        End If
    Next

    Set DiskSet = Nothing
    Set Disk = Nothing
    Set Locator = Nothing
    Set Service = Nothing

    getSKey = ret
End Function

12行目でディスクのリストを取得。15〜20行目で繰り返しディスクが固定ハードディスクであるかをチェックして、見つかったらそのディスク名とシリアル＃を結合して当関数の出力結果としている。16行目は Disk.MediaType = "Fixed hard disk media" とするのが正解かもしれないが、動作確認していない。
お試しする人に任せる。17行目は、ディスク名は不要かもしれないが、念のため付けておいた。

参考サイト

http://hensa40.cutegirl.jp/archives/5887

関連ページ

前のページ
次のページ