関連付けされた実行可能ファイル取得(U)          <TOP>


関連付けされた実行可能ファイルを取得します。

FindExecutable ファイル名に関連付けられている実行可能ファイル名とハンドルを取得

 

例では、ドラッグ&ドロップしたファイル名の関連EXEを取得します。

 

'================================================================
'= 関連付けされた実行可能ファイルを取得
'=    (FindExecutable2.bas)
'================================================================
#Include "Windows.bi"

' ファイル名に関連付けられている実行可能ファイル名とハンドルを取得
Declare Function Api_FindExecutable& Lib "shell32" Alias "FindExecutableA" (ByVal lpFile$, ByVal lpDirectory$, ByVal lpResult$)

Var Shared Text1 As Object
Var Shared Edit1 As Object
Var Shared Button1 As Object

Text1.Attach GetDlgItem("Text1") : Text1.SetFontSize 14
Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

Var Shared FileName As String

'================================================================
'=
'================================================================
Declare Function GetFileName(FileName As String) As String
Function GetFileName(FileName As String) As String
    Var Pfad As String
    Var Ret As Long
  
    Pfad = Space$(256)

    Ret = Api_FindExecutable(FileName, ByVal 0, Pfad)
    
    If Pfad <> "" Then
        Pfad = Left$(Pfad, InStr(Pfad, Chr$(0)) - 1)
    End If
    
    If UCase$(Pfad) = UCase$(FileName) Then Pfad = ""
  
    GetFileName = Pfad
End Function

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Edit1.SetWindowText FileName
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var sExe As String

    sExe = GetFileName(Edit1.GetWindowText)

    If sExe <> "" Then
        Text1.SetWindowText  sExe
    Else
        Text1.SetWindowText "関連アプリケーションは不明!"
    End If
End Sub

'================================================================
'=
'================================================================
Declare Sub Edit1_SetFocus edecl ()
Sub Edit1_SetFocus()
    Text1.SetWindowText ""
End Sub

'================================================================
'= シェルドロップされたファイル名を取得
'================================================================
Declare Sub Edit1_DropFiles edecl (ByVal DF As Long)
Sub Edit1_DropFiles(ByVal DF As Long)
    Var CN As Long

    CN = GetDropFileCount(DF)
    FileName = GetDropFileName(DF, 0)
    Edit1.SetWindowText FileName

    Text1.SetWindowText ""
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End