ボリューム情報を取得する

指定したボリューム(ドライブ)情報を取得するテクニックです。
ボリューム情報の1つのボリュームシリアル番号はフォーマットしたドライブごとに値が変化します。
この特性を利用してボリュームシリアル番号で簡易的なキー生成を行えば、シェアウェアのようにライセンス許可したPCのみで実行するプログラムの作成も可能です。

サンプル(32bit) ダウンロード

'ボリューム情報の取得
Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long

Private Const MAX_PATH               As Long = 260


Private Sub Command1_Click()
    
    Dim nRC As Long
    Dim sWIN_DIR As String
    Dim sWork_DIR As String
    Dim sVolumeName As String
    Dim nVolumeSerialNumber As Long
    Dim nMaximumComponentLength As Long
    Dim nFileSystemFlags As Long
    Dim sFileSystemNameBuffer As String

    'Windowsがインストールされているドライブを取得
    sWIN_DIR = Space$(255)
    nRC = GetWindowsDirectory(sWIN_DIR, Len(sWIN_DIR))
    sWIN_DIR = Left(sWIN_DIR, InStr(sWIN_DIR, Chr(0)) - 1)
    
    'ボリューム情報の取得にはルートパスにする必要があります
    sWork_DIR = Left(sWIN_DIR, 3)
    
    'ボリューム情報取得
    sVolumeName = Space(MAX_PATH)
    sFileSystemNameBuffer = Space(MAX_PATH)
    Call GetVolumeInformation(sWork_DIR, sVolumeName, MAX_PATH, nVolumeSerialNumber, nMaximumComponentLength, nFileSystemFlags, sFileSystemNameBuffer, MAX_PATH)

    '文字列にはNullが入ってるのでNullをカット
    sVolumeName = Left(sVolumeName, InStr(sVolumeName, Chr(0)) - 1)
    sFileSystemNameBuffer = Left(sFileSystemNameBuffer, InStr(sFileSystemNameBuffer, Chr(0)) - 1)
    
    'TextBoxにボリューム情報をセット
    Text1.Text = ""
    Text1.Text = Text1.Text & "WindowsDirectory:" & sWIN_DIR & vbCrLf
    Text1.Text = Text1.Text & vbCrLf
    Text1.Text = Text1.Text & "【 " & sWork_DIR & " 】Information" & vbCrLf
    Text1.Text = Text1.Text & "VolumeName:" & sVolumeName & vbCrLf
    Text1.Text = Text1.Text & "VolumeSerialNumber:" & Str(nVolumeSerialNumber) & vbCrLf
    Text1.Text = Text1.Text & "MaximumComponentLength:" & Str(nMaximumComponentLength) & vbCrLf
    Text1.Text = Text1.Text & "FileSystemFlags:" & Str(nFileSystemFlags) & vbCrLf
    Text1.Text = Text1.Text & "FileSystemFlags:" & sFileSystemNameBuffer & vbCrLf
    
End Sub

サンプル解説

GetVolumeInformation関数でボリューム情報を取得します。

GetVolumeInformation関数の引数lpRootPathNameに調べたいルートパスをセットして実行すると、引数lpVolumeNameBuffer 〜 nFileSystemNameSizeにボリュームの情報が返ってきます。

引数は次の通りです。
(引数の名前は、Declare Functionで指定したものです)

メンバー I/O 説明
lpRootPathName In 調べるドライブのルートパス(例:c:\)
サンプルではWindowsがインストールされているドライブのルートパスをセットしています。
lpVolumeNameBuffer Out ボリューム名を受け取るバッファ
nVolumeNameSize In lpVolumeNameBufferのサイズ
lpVolumeSerialNumber Out ボリュームシリアル番号
lpMaximumComponentLength Out パスの最大サイズ
lpFileSystemFlags Out ファイルシステムのフラグ
「ファイル名は、大文字/小文字の区別を保存できる」や「ボリュームは圧縮されている」などボリュームに関する情報が取得できる。詳しくは割愛。
lpFileSystemNameBuffer Out ファイルシステム名を受け取るバッファ
nFileSystemNameSize In lpFileSystemNameBufferのサイズ

取得したボリューム名やファイルシステム名には末尾にNullが入っているので除去する必要があります。

また、サンプルのように可変長の変数を渡す場合は、あらかじめ領域を確保しておく必要があります。

ネットワークドライブの場合、ボリュームシリアル番号は共有しているPCで全て同じ値になるのでシェアウェアのライセンスチェックに使用する場合はApp.PathよりOSがインストールされているドライブをチェックしたほうが良いでしょう。


[ Window Close ]