NonSoft

拡張子に関連づいたEXEのPATHを
取得するサンプル(VB6)


 サンプル(ソース/コード)
<このサンプルの概要>
拡張子に関連づいたEXE(アプリケーション)のPATHを取得するサンプル(VB6)です。

拡張子に関連づいたAPのPATHを取得するためにはレジストリから情報を取得する必要があります。
関連付けの情報はシステムが持っている情報とエクスプローラが持っている情報があります。
通常は、エクスプローラが持っている関連付けの情報でファイルを開きたいと思いますので、
このサンプルでも、まずエクスプローラが持っている関連付けの情報を検索し、見つからない時に
システムが持っている関連付けの情報を検索します。

システムが持っている関連付けの情報ですとテキストエディタはメモ帳です。

VB.NET版はこちらです。
拡張子に関連づいたEXEのPATHを取得するサンプル(VB.NET)

C#.NET版はこちらです。
拡張子に関連づいたEXEのPATHを取得するサンプル(C#.NET)

このサンプルは以下のようなフォルダ関係やファイル関係のツールで使用されています。
フォルダ内のファイル比較ツール
テキスト差分表示ツール
フォルダ監視人

★フォームモジュール(Form1.frm)
Option Explicit

' レジストリ関係API
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const KEY_ALL_ACCESS = &HF003F
Private 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
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hkey As Long) As Long
Private 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

Private Sub Command1_Click()
    MsgBox GetExtApPath("C:\Temp\Text.txt")
End Sub

' 関数名    : GetExtApPath
' 返り値    : コマンドライン
' 引き数    : path(i) : ファイルPATH(拡張子付き)
' 機能説明  : 拡張子に関連づいたアプリケーションのPATH取得(引数PATH付き)
Private Function GetExtApPath(ByVal fpath As String) As String
    On Error Resume Next
    GetExtApPath = ""
    
    Dim p1 As Long: p1 = InStr(fpath, ".")
    Dim p2 As Long: p2 = -1
    If p1 <= 0 Then Exit Function
    Do
        p2 = InStr(p1 + 1, fpath, ".")
        If p2 > 0 Then p1 = p2
    Loop While (p2 > 0)
    Dim ext As String
    ext = Mid$(fpath, p1)

    Dim strCmd As String: strCmd = ""
    Dim strApp As String: strApp = ""
    Dim strBuf As String
    Dim lngBuf As Long
    
    Dim ret   As Long
    Dim key   As Long
    Dim dtp   As Long
    
    ' 拡張子に関連づいたアプリケーションのPATH取得(エクスプローラ編)
    ret = RegOpenKeyEx(HKEY_CURRENT_USER, _
        "Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\" & _
        ext, 0, KEY_ALL_ACCESS, key)
    If (ret = 0) Then
        lngBuf = 511
        strBuf = String(lngBuf + 1, Chr(0))
        ret = RegQueryValueEx(key, "Application", 0, dtp, ByVal strBuf, lngBuf)
        If (ret = 0) Then
            strApp = Left$(strBuf, InStr(strBuf, Chr$(0)) - 1)
        End If
        ret = RegCloseKey(key)
    End If
    
    If strApp = "" Then
        ' アプリケーションが見つけられなかった場合はOpenWithListから探す
        ret = RegOpenKeyEx(HKEY_CURRENT_USER, _
            "Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\" & _
            ext & "\OpenWithList", 0, KEY_ALL_ACCESS, key)
        If (ret = 0) Then
            Dim mruList As String
            lngBuf = 511
            strBuf = String(lngBuf + 1, Chr(0))
            ret = RegQueryValueEx(key, "MRUList", 0, dtp, ByVal strBuf, lngBuf)
            mruList = Left$(strBuf, InStr(strBuf, Chr$(0)) - 1)
            lngBuf = 511
            strBuf = String(lngBuf + 1, Chr(0))
            ret = RegQueryValueEx(key, Left$(mruList, 1), 0, dtp, ByVal strBuf, lngBuf)
            strApp = Left$(strBuf, InStr(strBuf, Chr$(0)) - 1)
            ret = RegCloseKey(key)
        End If
    End If

    If strApp <> "" Then
        ' アプリケーションのPATH取得
        ret = RegOpenKeyEx(HKEY_CLASSES_ROOT, _
            "Applications\" & strApp & "\shell\open\command", 0, KEY_ALL_ACCESS, key)
        If (ret = 0) Then
            lngBuf = 511
            strBuf = String(lngBuf + 1, Chr(0))
            ret = RegQueryValueEx(key, "", 0, dtp, ByVal strBuf, lngBuf)
            strCmd = Left$(strBuf, InStr(strBuf, Chr$(0)) - 1)
            ret = RegCloseKey(key)
        End If
    End If

    If strCmd = "" Then
        ' 拡張子に関連づいたアプリケーションのPATH取得(システム編)
        ret = RegOpenKeyEx(HKEY_CLASSES_ROOT, ext, 0, KEY_ALL_ACCESS, key)
        If (ret = 0) Then
            Dim fileType As String
            lngBuf = 511
            strBuf = String(lngBuf + 1, Chr(0))
            ret = RegQueryValueEx(key, "", 0, dtp, ByVal strBuf, lngBuf)
            fileType = Left$(strBuf, InStr(strBuf, Chr$(0)) - 1)
            ret = RegCloseKey(key)
            
            ret = RegOpenKeyEx(HKEY_CLASSES_ROOT, _
                "" & fileType & "\shell\open\command", 0, KEY_ALL_ACCESS, key)
            If (ret = 0) Then
                lngBuf = 511
                strBuf = String(lngBuf + 1, Chr(0))
                ret = RegQueryValueEx(key, "", 0, dtp, ByVal strBuf, lngBuf)
                strCmd = Left$(strBuf, InStr(strBuf, Chr$(0)) - 1)
                ret = RegCloseKey(key)
            End If
        End If
    End If
            
    ' コマンドラインの引数部分に指定のファイルPATHを設定
    strCmd = Replace(strCmd, """%1""", """" & fpath & """")
    strCmd = Replace(strCmd, "%1", """" & fpath & """")

    GetExtApPath = GetEnvToRealPath(strCmd)
End Function

' 関数名    : GetEnvToRealPath
' 返り値    : PATH
' 引き数    : path(i) : PATH
' 機能説明  : PATH中の環境変数を変換する
Function GetEnvToRealPath(ByVal path As String) As String
    Dim i As Long
    Dim strAry() As String
    
    strAry = Split(path, "\")
    For i = 0 To UBound(strAry)
        If Left$(strAry(i), 1) = "%" And Right$(strAry(i), 1) = "%" Then
            Dim strTmp As String
            strTmp = Environ(Mid$(strAry(i), 2, Len(strAry(i)) - 2))
            If strTmp <> "" Then
                strAry(i) = strTmp
            End If
        End If
        If GetEnvToRealPath <> "" Then
            GetEnvToRealPath = GetEnvToRealPath & "\"
        End If
        GetEnvToRealPath = GetEnvToRealPath & strAry(i)
    Next i
End Function