|
|||||
<このサンプルの概要> 拡張子に関連づいた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 |