040104

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

レジストリサブキー内の全てのキー値を列挙
して値を取得します。

レジストリからまとめて値を取得したり、キー名が不明の時に
使うと便利です。

HKEY_CURRENT_USERキーの
サブキー　Software\VB and VBA Program Settings\TEST
にある全てのキー名と値を取得し件数を表示します。

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

1. フォームを作成しコマンドボタン（Command1）を貼り付けてください。

Option Explicit

Private Sub Command1_Click()

　　Dim RootKey As Long
　　Dim KeyPth As String
　　Dim KeyNm As String
　　Dim i As Long
　　Dim cnt As Long

　　RootKey = HKEY_CURRENT_USER
　　KeyPth = "Software\VB and VBA Program Settings\TEST"

　　cnt = Y_GetRegEnum(RootKey, KeyPth)

　　If cnt = -1 Then
　　　　Call MsgBox("キーが見つからんかったでぇ (ToT)")
　　Else
　　　　List1.Clear
　　　　For i = 0 To cnt
　　　　　　List1.AddItem KeyList(i)
　　　　Next
　　　　Call MsgBox("キーを列挙出来ました (^_^)v" + vbCrLf + "件数 =" & cnt + 1)
　　End If

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 RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" _
(ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, _
lpReserved As Long, lpType As Long, lpData As Any, lpcbData 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 KeyList() As String '列挙されたキーの名前の配列

Public Function Y_GetRegEnum(hKey As Long, SubKey As String) As Long

'***********************************************************
'機能 : レジストリのキーを列挙する
'引数 :　 hKey　　= 取得するサブキーの親キー
'　　　　　SubKey　= 取得するサブキーのパス
'戻り値: 列挙したキーの数 -1
'***********************************************************

　　Dim phKey As Long
　　Dim longret As Long
　　Dim KeyName As String
　　Dim LenKeyName As Long
　　Dim LenBuf As Long
　　Dim Idx As Long
　　Dim DataType As Long
　　Dim ByteBuf() As Byte
　　Dim strbuf As String
　　Dim DWordBuf As Currency
'配列初期化
　　ReDim keykust(0)

'レジストリキーを開く
　　If RegOpenKeyEx(hKey, SubKey, 0, KEY_ALL_ACCESS, phKey) = ERROR_SUCCESS Then
　　　　Idx = 0
　　　　longret = ERROR_SUCCESS
　　　　Do While True 'longret = ERROR_SUCCESS
　　　　　　KeyName = String$(80, vbNullChar)
　　　　　　LenKeyName = Len(KeyName)
'レジストリキーを列挙
　　　　　　If RegEnumValue(phKey, Idx, KeyName, LenKeyName, ByVal 0&, DataType, ByVal 0&, LenBuf) = ERROR_SUCCESS Then

　　　　　　　　ReDim Preserve KeyList(Idx)
　　　　　　　　KeyList(Idx) = EditBuf(KeyName) & " = "

'データタイプ毎に値を取得する
　　　　　　　　Select Case DataType
　　　　　　　　　　Case REG_SZ '文字列
　　　　　　　　　　　　strbuf = String$(LenBuf, vbNullChar)
　　　　　　　　　　　　longret = RegEnumValue(phKey, Idx, KeyName, LenKeyName, ByVal 0&, DataType, ByVal strbuf, LenBuf)
　　　　　　　　　　　　KeyList(Idx) = KeyList(Idx) & EditBuf(strbuf)

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

　　　　　　　　　　Case REG_BINARY 'バイナリ
　　　　　　　　　　　　ByteBuf = String$(LenBuf, vbNullChar)
　　　　　　　　　　　　longret = RegEnumValue(phKey, Idx, KeyName, LenKeyName, ByVal 0&, DataType, ByteBuf(0), LenBuf)
　　　　　　　　　　　　KeyList(Idx) = KeyList(Idx) & StrConv(ByteBuf, vbUnicode)
　　　　　　　　End Select
　　　　　　　　Idx = Idx + 1
　　　　　　Else
　　　　　　　　Exit Do
　　　　　　End If
　　　　Loop

'レジストリを閉じる
　　　　longret = RegCloseKey(phKey)
　　　　Y_GetRegEnum = Idx - 1
　　Else
　　　　Y_GetRegEnum = -1
　　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