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

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

サンプル（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が入っているので除去する必要があります。

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

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

[ Window Close ]