電子書籍の厳選無料作品が豊富!

お世話になります。

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の時は問題なく動いていました。

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

A 回答 (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
    • good
    • 0
この回答へのお礼

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

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

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

お礼日時:2005/10/26 16:37

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!