040101

タイトル	レジストリキーの値を取得する
対象言語	VB4.0, Access95以降
動作確認ＯＳ	Windows95,98,NT4.0
使用関数	RegQueryValueEx RegOpenKeyEx RegCloseKey
改築日	1999/06/22(1998/06/18)
Source Download

レジストリから、文字列、数値、バイナリ値
を取得します。

HKEY_CURRENT_USERキーの
サブキー　Software\VB and VBA Program Settings\TEST
にあるキー値、StringTest,DWordTest,BinaryTest
の値を取得します。
（これらの値は 040102 のサンプルで作成された値です）

注意！！
レジストリを操作するのは大変危険です。へたにいじるとWindowsが起動
しなくなるかもしれません。ご注意下さい！！

1. フォームを作成しコマンドボタン（Command1）、テキストボックス(Text1,text2,Text3)を貼り付けてください。

Private Sub Command1_Click()

　　Dim RootKey As Long
　　Dim KeyPth As String
　　Dim ByteBuf() As Byte
　　Dim strbuf As String

　　RootKey = HKEY_CURRENT_USER
　　KeyPth = "Software\VB and VBA Program Settings\TEST"
'文字列取得
　　Text1 = Y_GetRegValue(RootKey, KeyPth, "StringTest", "見つかりませんでした(ToT)")
'DWORD値取得
　　Text2 = Y_GetRegValue(RootKey, KeyPth, "DWordTest", 0)
'バイナリ値取得
　　ByteBuf() = Y_GetRegValue(RootKey, KeyPth, "BinaryTest", vbNullChar)
　　strbuf = String$(UBound(ByteBuf) * 2, vbNullChar)
　　LSet strbuf = StrConv(ByteBuf, vbUnicode)
　　Text3 = EditBuf(strbuf)

End Sub

2.モジュールウインドウを作成し、下のソースを入力してください。

Option Explicit

'レジストリキーを開く
Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" _
(ByVal hkey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
ByVal samDesired As Long, phkResult As Long) As Long

'レジストリキーを閉じる
Declare Function RegCloseKey Lib "advapi32" (ByVal hkey As Long) As Long

'レジストリキーの値を取得する
Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" _
(ByVal hkey As Long, ByVal lpszValueName As String, ByVal dwReserved As Long, _
lpdwType As Long, lpbData As Any, cbData As Long) As Long

'hKeyの設定値
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006

'lpTypeの戻り値
Public Const REG_BINARY = 3 ' Free form binary
Public Const REG_DWORD = 4 ' 32-bit number
Public Const REG_DWORD_LITTLE_ENDIAN = 4 ' 32-bit number (same as REG_DWORD)
Public Const REG_DWORD_BIG_ENDIAN = 5 ' 32-bit number
Public Const REG_EXPAND_SZ = 2 ' Unicode nul terminated string
Public Const REG_LINK = 6 ' Symbolic Link (unicode)
Public Const REG_MULTI_SZ = 7 ' Multiple Unicode strings
Public Const REG_NONE = 0 ' No value type
Public Const REG_RESOURCE_LIST = 8 ' Resource list in the resource map
Public Const REG_SZ = 1 ' Unicode nul terminated string

Public Const KEY_ALL_ACCESS = &HF003F
Public Const ERROR_SUCCESS = 0

Public Function Y_GetRegValue(hkey As Long, SubKey As String, KeyName As String, DefaultValue As Variant) As Variant

'***********************************************************
'機能 : レジストリの値を取得する
'引数 :　 hKey　　= 取得するサブキーの親キー
'　　　　　SubKey　= 取得するサブキーのパス
'　　　　　KeyName = 取得する値の名前
'　　　　　DefaultValue = データが無い場合の戻り値
'戻り値: レジストリの値
'***********************************************************

　　Dim phKey As Long
　　Dim DataType As Long
　　Dim LenBuf As Long
　　Dim strbuf As String
　　Dim DWordBuf As Currency
　　Dim ByteBuf() As Byte
　　Dim longret As Long

'レジストリキーを開く
　　If RegOpenKeyEx(hkey, SubKey, 0, KEY_ALL_ACCESS, phKey) = ERROR_SUCCESS Then

'バッファサイズとデータタイプを取得する
　　　　If RegQueryValueEx(phKey, KeyName, 0, DataType, ByVal 0, LenBuf) = ERROR_SUCCESS Then

'データタイプ毎にキー値の取得
　　　　　　Select Case DataType
　　　　　　　　Case REG_SZ '文字列
　　　　　　　　　　strbuf = String$(LenBuf, vbNullChar)
　　　　　　　　　　longret = RegQueryValueEx(phKey, KeyName, 0, DataType, ByVal strbuf, LenBuf)
　　　　　　　　　　Y_GetRegValue = EditBuf(strbuf)

　　　　　　　　Case REG_DWORD 'DWORD値
　　　　　　　　　　longret = RegQueryValueEx(phKey, KeyName, 0, DataType, DWordBuf, LenBuf)
　　　　　　　　　　Y_GetRegValue = DWordBuf * 10000 '符号無しで取得する為に Currency型で受け取る

　　　　　　　　Case REG_BINARY 'バイナリ
　　　　　　　　　　ByteBuf = String$(LenBuf, vbNullChar)
　　　　　　　　　　longret = RegQueryValueEx(phKey, KeyName, 0, DataType, ByteBuf(0), LenBuf)
　　　　　　　　　　Y_GetRegValue = ByteBuf

　　　　　　　　Case Else 'その他
　　　　　　　　　　Y_GetRegValue = DefaultValue
　　　　　　End Select
　　　　Else
　　　　　　Y_GetRegValue = DefaultValue
　　　　End If

'レジストリを閉じる
　　　　longret = RegCloseKey(phKey)
　　Else
　　　　Y_GetRegValue = DefaultValue
　　End If

End Function

Public Function EditBuf(Buf As String) As String
'***********************************************************
'機能 : 引数 Bufの文字列中の Nullコードを検索し、Nullコードを
'　　　　除いた文字列を返す
'引数 : Buf = Nullコードを含む文字列
'戻り値: Nullコードを除いた文字列
'***********************************************************

　　Dim i As Long

　　i = InStr(Buf, vbNullChar)
　　If i <> 0 Then
　　　　EditBuf = Left$(Buf, i - 1)
　　Else
　　　　EditBuf = Buf
　　End If

End Function