Windows のプロダクトＩＤを取得するユーザー定義関数

対象バージョン : 97, 2000, 2002, 2003
最終更新日 : 2005/04/25 （オリジナル作成日：1998/09/01）

概　要　

　コントロールパネルのシステムで表示される Windows のプロダクトＩＤがレジストリに記録されていますので、これを取得するユーザー定義関数です。

解　説

General - Declarations

Public Const HKEY_LOCAL_MACHINE = &H80000002

Public Const REG_SZ = 1&
Public Const SYNCHRONIZE = &H100000
Public Const READ_CONTROL = &H20000
Public Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or _
    KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))

Public Const VER_PLATFORM_WIN32_NT = 2

Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" _
    (ByVal hkeyRoot As Long, ByVal lpszSubKey As String, ByVal ulOptions As Long, _
    ByVal samDesired As Long, phkeyResult As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
    (ByVal hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
    lpType As Long, lpData As Any, lpcbData As Long) As Long
Declare Function RegCloseKey Lib "advapi32" (ByVal hkey As Long) As Long

Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
    (lpVersionInformation As OSVERSIONINFO) As Long

Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Function プロシージャ

Function GetWinProductId() As String
Dim stSubKey As String
Dim stProductid As String * 255
Dim hkeyRoot As Long
Dim lErr As Long
Dim OSVER As OSVERSIONINFO

OSVER.dwOSVersionInfoSize = Len(OSVER)
lErr = GetVersionEx(OSVER)
If lErr = 0 Then Exit Function
    
If OSVER.dwPlatformId = VER_PLATFORM_WIN32_NT Then
    stSubKey = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"
Else
    stSubKey = "SOFTWARE\Microsoft\Windows\CurrentVersion"
End If

lErr = RegOpenKeyEx(HKEY_LOCAL_MACHINE, stSubKey, 0&, KEY_READ, hkeyRoot)
If lErr <> 0 Then Exit Function
lErr = RegQueryValueEx(hkeyRoot, "ProductId", 0&, REG_SZ, ByVal stProductid, 255)
lErr = RegCloseKey(hkeyRoot)
If lErr <> 0 Then Exit Function
'
'  97 まではこれで動作可（これは以前の掲載内容）
' GetWinProductId = Left(stProductid, InStr(stProductid, vbNullChar))
'
' 2000 では、以下のようにしないと実行時エラーが発生することがあります。97 でも動作します。
GetWinProductId = Left(stProductid, InStr(1, stProductid, vbNullChar, vbBinaryCompare))
End Function

補　足

• 各パラメータの意味は、Windows API の解説書をご参照ください。

改訂履歴

• 1998/09/03 Windows NT 対応
• 1999/08/25 Access 2000 での InStr 関数の動作不全により、代替方法を記載
• 2001/06/14 Access 2002, Windows 2000 Professional での動作確認。

目次へ戻る