RegQueryValueExwでエラー

質問

お世話になります。

Declare Function RegQueryValueExString Lib "advapi32.dll" Alias _
"RegQueryValueExA"(ByVal hKey As Integer, ByVal lpValueName As String, ByVal lpReserved As Integer, ByRef lpType As Integer, ByVal lpData As String, ByRef lpcbData As Integer) As Integer

RegQueryValueExString(hKey, ValueName, 0, intType, strValue, intSize)
この時、ValueNameに２バイト文字が含まれているとエラーになります。
VB 6.0の時は問題なく動いていました。

ご存知の方ご教示お願いいたします。

回答No.1

1050 円（@1050YEN） · ベストアンサー

>RegQueryValueExwでエラー
>Declare Function
>ValueNameに２バイト文字

これは文字コードの関係で発生しているだけだと思います。
パラメータに文字コードを指定すると、そのまま利用可能かもしれません。

いっその事、VB6をそのまま利用せず、ちょっと宣言に改造を加えましょう。
さらに、おまけで「RegQueryValueExAとRegQueryValueExWを意識させない作り」にしちゃいましょう。
これは「System.Runtime.InteropServices」を利用することにより、宣言の改造で実現できます。

RegQueryValueExは前後の関係もあるので、、、

VB6の元ネタ
http://okwave.jp/kotaeru.php3?q=1253134
をコンバートして張っておきます。(Class:API_Win32)

さらに、せっかくの.NETなので、Frameworkを利用したバージョンも載せておきます。(Class:API_NET_Framework)
http://www.microsoft.com/japan/msdn/net/general/win32map.asp

※構成
WindowsApplicationXX.vbproj
└Module1.vb

Main()から開始する構成です。

Module1.vbにクラス部分も含め、下のコードをそのまま全部張ってください。

>Dim objClass As New API_Win32()
>Dim objClass As New API_NET_Framework()
のどちらかをのコメントを解除してください。

---------------------------------------------------------------------------------------------------------------------------
Option Compare Binary
Option Strict On
Option Explicit On

Imports System.Runtime.InteropServices
Module Module1
　　'アンインストールルート
　　Public Const DEFSTR_UNINSTALL_REG_SUBKEY_PARENT As String = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
　　'アンインストール表示名称取得用キー
　　Public Const DEFSTR_UNINSTALL_REG_NAME_DISPLAYNAME As String = "DisplayName"

　　Sub Main()
　　　　'-----------------------------
　　　　'使いたい方を、コメント解除して使う
　　　　'Dim objClass As New API_Win32()
　　　　'Dim objClass As New API_NET_Framework()
　　　　'-----------------------------
　　　　Dim colWk As Collection
　　　　Dim i As Integer

　　　　If Not objClass.Test(colWk) Then
　　　　　　MsgBox("失敗")
　　　　End If

　　　　For i = 1 To colWk.Count
　　　　　　Console.WriteLine(colWk(i))
　　　　Next i
　　End Sub
End Module

'WIN32 APIバージョン
Public Class API_Win32
　　Private Structure FILETIME
　　　　Dim dwLowDateTime As Integer
　　　　Dim dwHighDateTime As Integer
　　End Structure

　　Private Const HKEY_CLASSES_ROOT As Integer = &H80000000
　　Private Const HKEY_CURRENT_USER As Integer = &H80000001
　　Private Const HKEY_LOCAL_MACHINE As Integer = &H80000002
　　Private Const HKEY_USERS As Integer = &H80000003
　　Private Const HKEY_PERFORMANCE_DATA As Integer = &H80000004
　　Private Const HKEY_CURRENT_CONFIG As Integer = &H80000005
　　Private Const HKEY_DYN_DATA As Integer = &H80000006

　　Private Const MAX_LEN As Integer = 2048
　　Private Const KEY_QUERY_VALUE As Integer = &H1
　　Private Const KEY_ENUMERATE_SUB_KEYS As Integer = &H8
　　Private Const KEY_NOTIFY As Integer = &H10
　　Private Const SYNCHRONIZE As Integer = &H100000
　　Private Const STANDARD_RIGHTS_READ As Integer = &H20000
　　Private Const KEY_READ As Integer = ((STANDARD_RIGHTS_READ Or _
　　　　　　　　　KEY_QUERY_VALUE Or _
　　　　　　　　　KEY_ENUMERATE_SUB_KEYS Or _
　　　　　　　　　KEY_NOTIFY) And (Not SYNCHRONIZE))

　　Private Const ERROR_SUCCESS As Integer = 0&

　　<DllImport("advapi32.dll", CharSet:=CharSet.Unicode, SetLastError:=True)> _
　　Private Shared Function RegOpenKeyEx( _
　　　　　　ByVal hKey As Integer, _
　　　　　　<MarshalAs(UnmanagedType.LPTStr)> ByVal lpSubKey As String, _
　　　　　　ByVal ulOptions As Integer, _
　　　　　　ByVal samDesired As Integer, _
　　　　　　ByRef phkResult As IntPtr _
　　) As Integer
　　End Function

　　<DllImport("advapi32.dll", CharSet:=CharSet.Unicode, SetLastError:=True)> _
　　Private Shared Function RegCloseKey( _
　　　　　　ByVal hKey As IntPtr _
　　) As Integer
　　End Function

　　<DllImport("advapi32.dll", CharSet:=CharSet.Unicode, SetLastError:=True)> _
　　Private Shared Function RegEnumKeyEx( _
　　　　　　ByVal hKey As IntPtr, _
　　　　　　ByVal dwIndex As Integer, _
　　　　　　<MarshalAs(UnmanagedType.LPTStr)> ByVal lpName As String, _
　　　　　　ByRef lpcbName As Integer, _
　　　　　　ByVal lpReserved As Integer, _
　　　　　　<MarshalAs(UnmanagedType.LPTStr)> ByVal lpClass As String, _
　　　　　　ByRef lpcbClass As Integer, _
　　　　　　<MarshalAs(UnmanagedType.Struct)> ByRef lpftLastWriteTime As FILETIME _
　　) As Integer
　　End Function

　　<DllImport("advapi32.dll", CharSet:=CharSet.Unicode, SetLastError:=True)> _
　　Private Shared Function RegQueryValueEx( _
　　　　　　ByVal hKey As IntPtr, _
　　　　　　 <MarshalAs(UnmanagedType.LPTStr)> ByVal lpValueName As String, _
　　　　　　ByVal lpReserved As Integer, _
　　　　　　ByRef lpType As Integer, _
　　　　　　<MarshalAs(UnmanagedType.LPTStr)> ByVal lpData As String, _
　　　　　　ByRef lpcbData As Integer _
　　) As Integer
　　End Function

　　Public Function Test( _
　　　　Optional ByRef p_coRet As Collection = Nothing _
　　) As Boolean
　　　　p_coRet = New Collection()
　　　　If Not GetAppUnInstDisplay(p_coRet) Then
　　　　　　Return False
　　　　End If

　　　　Return True
　　End Function

　　'アンインストール情報表示名の取得
　　Private Function GetAppUnInstDisplay( _
　　　　　　Optional ByRef otCol As Collection = Nothing _
　　) As Boolean
　　　　Dim intRet As Integer
　　　　Dim hReg As IntPtr
　　　　Dim intIndex As Integer
　　　　Dim strBuffSubKey As String
　　　　Dim FT As FILETIME
　　　　Dim strSubKey As String
　　　　Dim strDspName As String

　　　　'返りコレクション初期化
　　　　otCol = New Collection()

　　　　'キーオープン
　　　　If Not (ERROR_SUCCESS = RegOpenKeyEx(HKEY_LOCAL_MACHINE, DEFSTR_UNINSTALL_REG_SUBKEY_PARENT, 0, KEY_READ, hReg)) Then
　　　　　　'キーオープン失敗なので、強制抜け
　　　　　　Exit Function
　　　　End If

　　　　'インデックス初期化
　　　　intIndex = 0
　　　　Do
　　　　　　'intIndex個目のサブキーを取得
　　　　　　strBuffSubKey = New String(CChar(vbNullChar), MAX_LEN)

　　　　　　intRet = RegEnumKeyEx(hReg, intIndex, strBuffSubKey, MAX_LEN, 0, vbNullString, 0, FT)
　　　　　　If intRet = ERROR_SUCCESS Then
　　　　　　　　'値を取得するサブキーの整理
　　　　　　　　strSubKey = DEFSTR_UNINSTALL_REG_SUBKEY_PARENT & "\" & BuffArrangement(strBuffSubKey)

　　　　　　　　'アンインストール表示名称の取得
　　　　　　　　If GetRegValue(HKEY_LOCAL_MACHINE, strSubKey, DEFSTR_UNINSTALL_REG_NAME_DISPLAYNAME, strDspName) Then
　　　　　　　　　　'取得できたなら、コレクションに追加
　　　　　　　　　　otCol.Add(strDspName)
　　　　　　　　End If

　　　　　　　　'インデックスを進める
　　　　　　　　intIndex = intIndex + 1
　　　　　　End If
　　　　Loop While intRet = 0

　　　　GetAppUnInstDisplay = True
PGMEND:
　　　　'キークローズ
　　　　Call RegCloseKey(hReg)
　　End Function

　　'レジストリ値取得(文字列)
　　Private Function GetRegValue( _
　　　　　　ByVal inKey As Integer, _
　　　　　　ByVal inSubKey As String, _
　　　　　　ByVal inName As String, _
　　　　　　Optional ByRef otValue As String = Nothing _
　　) As Boolean
　　　　Dim hReg As IntPtr
　　　　Dim strBuffValue As String
　　　　Dim intLen As Integer
　　　　Dim intType As Integer

　　　　'キーオープン
　　　　If Not (ERROR_SUCCESS = RegOpenKeyEx(inKey, inSubKey, 0, KEY_QUERY_VALUE, hReg)) Then
　　　　　　Exit Function
　　　　End If

　　　　'レジストリ値取得メイン
　　　　strBuffValue = New String(CChar(vbNullChar), MAX_LEN)
　　　　If (ERROR_SUCCESS = RegQueryValueEx(hReg, inName, 0, intType, strBuffValue, MAX_LEN)) Then
　　　　　　otValue = BuffArrangement(strBuffValue)
　　　　　　GetRegValue = (otValue <> "")
　　　　End If

　　　　'キークローズ
　　　　Call RegCloseKey(hReg)
　　End Function

　　'API独特のバッファNULL文字の消去
　　Private Function BuffArrangement(ByVal inBuff As String) As String
　　　　On Error Resume Next
　　　　BuffArrangement = Left$(inBuff, InStr(1, inBuff, vbNullChar) - 1)
　　End Function
End Class

'.NET Framework API バージョン
Public Class API_NET_Framework
　　Public Function Test( _
　　　　Optional ByRef p_coRet As Collection = Nothing _
　　) As Boolean
　　　　p_coRet = New Collection()
　　　　If Not GetAppUnInstDisplay(p_coRet) Then
　　　　　　Return False
　　　　End If

　　　　Return True
　　End Function

　　'アンインストール情報表示名の取得
　　Private Function GetAppUnInstDisplay( _
　　　　　　Optional ByRef otCol As Collection = Nothing _
　　) As Boolean
　　　　Dim l_strBuffSubKey As String
　　　　Dim l_strSubKey As String
　　　　'レジストリ/アンインストール情報のルート取得
　　　　Dim l_regUnInst_Root As Microsoft.Win32.RegistryKey
　　　　Dim l_regUnInst_Sub As Microsoft.Win32.RegistryKey

　　　　'返りコレクション初期化
　　　　otCol = New Collection()

　　　　'レジストリ/アンインストール情報のルート取得
　　　　l_regUnInst_Root = Microsoft.Win32.Registry.LocalMachine.OpenSubKey(DEFSTR_UNINSTALL_REG_SUBKEY_PARENT)
　　　　If (l_regUnInst_Root Is Nothing) Then
　　　　　　'取得失敗
　　　　　　Exit Function
　　　　End If

　　　　Dim objWk As Object
　　　　'ルート内部のサブキーでループ
　　　　For Each l_strBuffSubKey In l_regUnInst_Root.GetSubKeyNames()
　　　　　　''値を取得するサブキーの整理
　　　　　　l_strSubKey = DEFSTR_UNINSTALL_REG_SUBKEY_PARENT & "\" & l_strBuffSubKey

　　　　　　l_regUnInst_Sub = Microsoft.Win32.Registry.LocalMachine.OpenSubKey(l_strSubKey)
　　　　　　'アンインストール表示名称の取得
　　　　　　objWk = l_regUnInst_Sub.GetValue(DEFSTR_UNINSTALL_REG_NAME_DISPLAYNAME)
　　　　　　If Not (objWk Is Nothing) Then
　　　　　　　　'取得できたなら、コレクションに追加
　　　　　　　　otCol.Add(objWk.ToString)
　　　　　　End If
　　　　Next

　　　　l_regUnInst_Root.Close()

　　　　GetAppUnInstDisplay = True
　　End Function
End Class

お礼

1050YENさん、有難うございました。

サンプルを参考に
.NET Framework API バージョン
で作成してみました。

ゴチャゴチャしたコードがすっきり見やすくなりました。
今後ともよろしくお願いいたします。