![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?8acaa2e)
お世話になります。
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に2バイト文字が含まれているとエラーになります。
VB 6.0の時は問題なく動いていました。
ご存知の方ご教示お願いいたします。
No.1ベストアンサー
- 回答日時:
>RegQueryValueExwでエラー
>Declare Function
>ValueNameに2バイト文字
これは文字コードの関係で発生しているだけだと思います。
パラメータに文字コードを指定すると、そのまま利用可能かもしれません。
いっその事、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/ …
※構成
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 バージョン
で作成してみました。
ゴチャゴチャしたコードがすっきり見やすくなりました。
今後ともよろしくお願いいたします。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Access(アクセス) Vba Userformを前面に出すについて 3 2022/04/15 12:29
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Excel(エクセル) エクセルのマクロについて教えてください。 2 2023/01/11 08:33
- Excel(エクセル) excel vba 参照渡しと値渡し 2 2022/04/27 10:45
- Visual Basic(VBA) エクセルVBAで以下のようなコードを書いたらエラーになりました。何処が間違っているの教えて? 1 2023/02/10 18:30
- Visual Basic(VBA) エクセルのマクロについて教えてください。 2 2023/07/15 15:12
- Visual Basic(VBA) VBA 改行コードの取り方 1 2022/03/22 14:14
- Excel(エクセル) 【マクロ】スクショ印刷がうまく動かない件 5 2022/12/06 17:37
- Visual Basic(VBA) 【ご教示ください】VBAの記述方法がわかりません。 2 2022/08/12 21:28
- Visual Basic(VBA) エクセルのマクロについて教えてください。 2 2023/07/15 15:48
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
VBA:小数点以下の数字を取得で...
-
VB.NETで DataRow()を利用して...
-
VBAでActiveDirectoryのユーザ...
-
count(*)で取得した値をJAVAの...
-
JSP+Servletでのページングの常識
-
ListView 項目の選択/選択解除...
-
Flexgridで選択行の列の値を取...
-
PCインストール済みのアプリケ...
-
エクセルVBAで複数選択できるよ...
-
データ数をカウントしたいのですが
-
利用者側のMACアドレスを取得し...
-
エクセルVBAで範囲内での位置取...
-
HKEY_USERS下のキーを取得したい
-
「Excel VBA」 Webクエリ マク...
-
秒以下は取得できないですか?
-
Spreadの選択行の取得について
-
Google Apps Script で、Web上...
-
コンボボックスの表示は最大何行?
-
C言語におけるコンピュータ名・...
-
javascriptのonclickで、ループ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
VB.NETで DataRow()を利用して...
-
count(*)で取得した値をJAVAの...
-
ListView 項目の選択/選択解除...
-
データ数をカウントしたいのですが
-
VBA:小数点以下の数字を取得で...
-
VBAでActiveDirectoryのユーザ...
-
Flexgridで選択行の列の値を取...
-
like演算子内に変数って使えな...
-
ListViewで複数選択された項目...
-
getParameter と getAttribut...
-
JSP+Servletでのページングの常識
-
JavaScriptでWindowsログオンID...
-
利用者側のMACアドレスを取得し...
-
Spreadの選択行の取得について
-
Excel VBA でログインしてい...
-
コンボボックス表示文字列を取...
-
C言語におけるコンピュータ名・...
-
「Excel VBA」 Webクエリ マク...
-
エクセルVBAで複数選択できるよ...
-
VBScriptで数値にコンマを付け...
おすすめ情報