unit GetFullExePathUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Edit2: TEdit;
    Edit1: TEdit;
    Button1: TButton;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  ComObj,
  ShLwApi;

{$R *.DFM}

//=============================================================================
//  テスト用の拡張子をEditにセット
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  CheckBox1.Checked := True;
  CheckBox2.Checked := False;
  Edit1.Text     := '.doc';

  Edit2.ReadOnly := True;
  Edit2.Text     := '';
end;

//=============================================================================
//  指定した拡張子に関連づけた実行ファイルのフルパス名を取得する関数
//  取得するのは拡張子の関連付けがレジストリに登録されているものの最初のもの
//
//  AssocQueryStringの使用にはusesにShLwApiが必要
//  OleCheckやWin32Checkを入れておくと例外を検出してくれる
//  OleCheckやWin32Checkの使用にはuuseにComObjが必要
//=============================================================================
function GetRelatedFullExePath(ExtName: String;
  DoubleQuote: Boolean=True; CmdParams: Boolean=False): String;
var
  LBuffer : array [0..MAX_PAtH-1] of Char;
  LdwOut  : DWORD;
begin
  Result := '';

  FillChar(LBuffer, SizeOf(LBuffer), #0);
  LdwOut := MAX_PATH;

  try
    //第2引数をASSOCSTR_EXECUTABLEにすれば"を含まないパス文字列となる
    if DoubleQuote then begin
      OleCheck(ShLwApi.AssocQueryString(ASSOCF_NOTRUNCATE,
                                        ASSOCSTR_COMMAND,
                                        PChar(ExtName),
                                        nil,
                                        LBuffer,
                                        @LdwOut));
    end else begin
      OleCheck(ShLwApi.AssocQueryString(ASSOCF_NOTRUNCATE,
                                        ASSOCSTR_EXECUTABLE,
                                        PChar(ExtName),
                                        nil,
                                        LBuffer,
                                        @LdwOut));
    end;
    Result := LBuffer;

    if Length(Result) = 0 then begin
      Result := '';
    end else begin
      if not CmdParams then begin
        //"(ダブルコーテーション)で囲まれている場合
        if Pos('" ', Result) > 0 then begin
          Result := Copy(Result, 1, Pos('" ', Result) + 1);
        end;
      end;
    end;
  except
  end;
end;

//=============================================================================
//  指定した拡張子に関連付け実行ファイルのフルパス名を取得
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit2.Text := GetRelatedFullExePath(Edit1.Text,
                                      CheckBox1.Checked,
                                      CheckBox2.Checked);
end;

end.

C++

  HRESULT AssocQueryString(
  _In_       ASSOCF flags,
  _In_       ASSOCSTR str,
  _In_       LPCTSTR pszAssoc,
  _In_opt_   LPCTSTR pszExtra,
  _Out_opt_  LPTSTR pszOut,
  _Inout_    DWORD *pcchOut
);

function AssocQueryStringA(
              flags    : Cardinal;
              str      : Cardinal;
              pszAssoc : PChar;
              pszExtra : PChar;
              pszOut   : PChar;
              pcchOut  : PDWORD): HRESULT; stdcall; external 'Shlwapi.dll'

AssocQueryStringW (Unicode) and AssocQueryStringA (ANSI)

function AssocQueryStringA(
              flags    : Cardinal;
              str      : Cardinal;
              pszAssoc : LPCTSTR;
              pszExtra : LPCTSTR;
              pszOut   : LPTSTR;
              pcchOut  : PDWORD): HRESULT; stdcall; external 'Shlwapi.dll';

unit GetFullExePathUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Edit2: TEdit;
    Edit1: TEdit;
    Button1: TButton;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

function AssocQueryStringA(
              flags    : Cardinal;
              str      : Cardinal;
              pszAssoc : PChar;
              pszExtra : PChar;
              pszOut   : PChar;
              pcchOut  : PDWORD): HRESULT; stdcall; external 'Shlwapi.dll';

const
  //第1引数用の定数
  ASSOCF_INIT_NOREMAPCLSID    = $00000001;
  ASSOCF_INIT_BYEXENAME       = $00000002;
  ASSOCF_OPEN_BYEXENAME       = $00000002;
  ASSOCF_INIT_DEFAULTTOSTAR   = $00000004;
  ASSOCF_INIT_DEFAULTTOFOLDER = $00000008;
  ASSOCF_NOUSERSETTINGS       = $00000010;
  ASSOCF_NOTRUNCATE           = $00000020;
  ASSOCF_VERIFY               = $00000040;
  ASSOCF_REMAPRUNDLL          = $00000080;
  ASSOCF_NOFIXUPS             = $00000100;
  ASSOCF_IGNOREBASECLASS      = $00000200;
  ASSOCF_INIT_IGNOREUNKNOWN   = $00000400;

  //第2引数用の定数
  ASSOCSTR_COMMAND          = 1;
  ASSOCSTR_EXECUTABLE       = 2;
  ASSOCSTR_FRIENDLYDOCNAME  = 3;
  ASSOCSTR_FRIENDLYAPPNAME  = 4;
  ASSOCSTR_NOOPEN           = 5;
  ASSOCSTR_SHELLNEWVALUE    = 6;
  ASSOCSTR_DDECOMMAND       = 7;
  ASSOCSTR_DDEIFEXEC        = 8;
  ASSOCSTR_DDEAPPLICATION   = 9;
  ASSOCSTR_DDETOPIC         = 10;
  ASSOCSTR_INFOTIP          = 11;
  ASSOCSTR_MAX              = 12;

var
  Form1: TForm1;

implementation

uses ComObj;

{$R *.DFM}

//=============================================================================
//  サンプルの拡張子をEditにセット
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  CheckBox1.Checked := True;
  CheckBox2.Checked := False;
  Edit1.Text     := '.doc';

  Edit2.ReadOnly :=True;
  Edit2.Text     :='';
end;

//=============================================================================
//  指定した拡張子に関連づけた実行ファイルのフルパス名を取得する関数
//  取得するのは拡張子の関連付けがレジストリに登録されているものの最初のもの
//
//  OleCheckやWin32Checkを入れておくと例外を検出してくれる
//  OleCheckやWin32Checkの使用にはuuseにComObjが必要
//=============================================================================
function GetRelatedFullExePath(ExtName: String;
  DoubleQuote: Boolean=True; CmdParams: Boolean=False): String;
var
  LBuffer : array [0..MAX_PAtH-1] of Char;
  LdwOut  : DWORD;
begin
  Result := '';

  FillChar(Buf, SizeOf(LBuffer), #0);
  LdwOut := MAX_PATH;

  try
    //第2引数をASSOCSTR_EXECUTABLEにすれば"を含まないパス文字列となる
    if DoubleQuote then begin
      OleCheck(AssocQueryStringA(ASSOCF_NOTRUNCATE,
                                 ASSOCSTR_COMMAND,
                                 PChar(ExtName),
                                 nil,
                                 LBuffer,
                                 @LdwOut));
    end else begin
      OleCheck(AssocQueryStringA(ASSOCF_NOTRUNCATE,
                                 ASSOCSTR_EXECUTABLE,
                                 PChar(ExtName),
                                 nil,
                                 LBuffer,
                                 @LdwOut));
    end;
    Result := LBuffer;

    if Length(Result) = 0 then begin
      Result := '';
    end else begin
      if not CmdParams then begin
        //"(ダブルコーテーション)で囲まれている場合
        if Pos('" ', Result) > 0 then begin
          Result := Copy(Result, 1, Pos('" ', Result) + 1);
        end;
      end;
    end;
  except
  end;
end;

//=============================================================================
//  指定した拡張子に関連付け実行ファイルのフルパス名を取得
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit2.Text := GetRelatedFullExePath(Edit1.Text,
                                      CheckBox1.Checked,
                                      CheckBox2.Checked);
end;

end.

//  ASSOCF列挙型
//  TOleEnumの使用にはusesにActiveXが必要
type
  ASSOCF = TOleEnum;
const
  ASSOCF_INIT_NOREMAPCLSID    = $00000001;
  ASSOCF_INIT_BYEXENAME       = $00000002;
  ASSOCF_OPEN_BYEXENAME       = $00000002;
  ASSOCF_INIT_DEFAULTTOSTAR   = $00000004;
  ASSOCF_INIT_DEFAULTTOFOLDER = $00000008;
  ASSOCF_NOUSERSETTINGS       = $00000010;
  ASSOCF_NOTRUNCATE           = $00000020;
  ASSOCF_VERIFY               = $00000040;
  ASSOCF_REMAPRUNDLL          = $00000080;
  ASSOCF_NOFIXUPS             = $00000100;
  ASSOCF_IGNOREBASECLASS      = $00000200;
  ASSOCF_INIT_IGNOREUNKNOWN   = $00000400;


//  ASSOCSTR列挙型
//  TOleEnumの使用にはusesにActiveXが必要
type
  ASSOCSTR = TOleEnum;
const
  ASSOCSTR_COMMAND          = 1;
  ASSOCSTR_EXECUTABLE       = 2;
  ASSOCSTR_FRIENDLYDOCNAME  = 3;
  ASSOCSTR_FRIENDLYAPPNAME  = 4;
  ASSOCSTR_NOOPEN           = 5;
  ASSOCSTR_SHELLNEWVALUE    = 6;
  ASSOCSTR_DDECOMMAND       = 7;
  ASSOCSTR_DDEIFEXEC        = 8;
  ASSOCSTR_DDEAPPLICATION   = 9;
  ASSOCSTR_DDETOPIC         = 10;
  ASSOCSTR_INFOTIP          = 11;
  ASSOCSTR_MAX              = 12;


function AssocQueryStringA(
              flags    : ASSOCF;
              str      : ASSOCSTR;
              pszAssoc : PChar;
              pszExtra : PChar;
              pszOut   : PChar;
              pcchOut  : PDWORD): HRESULT; stdcall; external 'Shlwapi.dll';

var
  Form1: TForm1;

implementation

//=============================================================================
//  ディレクトリを除くEXE名からEXEのフルパスを取得する関数
//  取得可能なのはレジストリに登録されているもの
//  つまり、システム的にフルパスでなくても起動可能なプログラムに限る
//
//  AssocQueryStringの使用にはusesにShLwApiが必要
//  OleCheckやWin32Checkを入れておくと例外を検出してくれる
//  OleCheckやWin32Checkの使用にはuuseにComObjが必要
//=============================================================================
function GetRelatedFullExePath(ExtName: String;
  DoubleQuote: Boolean=True; CmdParams: Boolean=False): String;
var
  LBuffer : array [0..MAX_PAtH-1] of Char;
  LdwOut  : DWORD;
begin
  Result := '';

  FillChar(LBuffer, SizeOf(LBuffer), #0);
  LdwOut := MAX_PATH;

  try
    //第2引数をASSOCSTR_EXECUTABLEにすれば"を含まないパス文字列となる
    if DoubleQuote then begin
      OleCheck(ShLwApi.AssocQueryString(ASSOCF_NOTRUNCATE or ASSOCF_OPEN_BYEXENAME,
                                        ASSOCSTR_COMMAND,
                                        PChar(ExtName),
                                        nil,
                                        LBuffer,
                                        @LdwOut));
    end else begin
      OleCheck(ShLwApi.AssocQueryString(ASSOCF_NOTRUNCATE  or ASSOCF_OPEN_BYEXENAME,
                                        ASSOCSTR_EXECUTABLE,
                                        PChar(ExtName),
                                        nil,
                                        LBuffer,
                                        @LdwOut));
    end;
    Result := LBuffer;

    if Length(Result) = 0 then begin
      Result := '';
    end else begin
      if not CmdParams then begin
        //"(ダブルコーテーション)で囲まれている場合
        if Pos('" ', Result) > 0 then begin
          Result := Copy(Result, 1, Pos('" ', Result) + 1);
        end;
      end;
    end;
  except
  end;
end;

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  ShellAPI;

{$R *.dfm}

//=============================================================================
//  テスト用のファイル名をセット
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text := ExtractFilePath(Application.ExeName) + 'Test.doc';
  Memo1.Lines.Clear;
end;

//=============================================================================
//  ファイルのフルパスから、起動するアプリのEXE名を取得
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFilePath    : string;
  LExeFullPath : String;
  LBuffer      : array[0..MAX_PATH-1] of Char;
  LResult      : HINST;
  i            : Integer;
begin
  //ファイルのフルパス
  LFilePath := Trim(Edit1.Text);

  //初期化しないとゴミが入って正しく取得できない場合がある
  FillChar(LBuffer, SizeOf(LBuffer), #0);
  LResult := FindExecutable(PChar(LFilePath), nil, LBuffer);

  if LResult > 32 then begin
    for i := Low(LBuffer) to High(LBuffer) - 1 do begin
      if LBuffer[i] = #0 then LBuffer[i] := #32;
    end;
    LBuffer[High(LBuffer)] := #0;
    LExeFullPath := Trim(LBuffer);
  end else begin
    LExeFullPath := IntToStr(LResult);
  end;

  Memo1.Lines.Add(LExeFullPath);
end;

end.

implementation

uses
  ShellAPI;

{$R *.dfm}

//=============================================================================
//  テスト用のファイル名をセット
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text := ExtractFilePath(Application.ExeName) + 'Test.doc';
  Memo1.Lines.Clear;
end;

//=============================================================================
//  ファイルのフルパスから、起動するアプリのEXE名を取得
//  文字列バッファとしてPChar型を使用する例
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFilePath    : string;
  LExeFullPath : String;
  LResult      : HINST;
  LpResultChar : PChar;
 begin
  //ファイルのフルパス
  LFilePath := Trim(Edit1.Text);

  //文字列バッファの領域を確保して関数を実行
  LpResultChar := StrAlloc(MAX_PATH + 1);
  try
    LResult := FindExecutable(PChar(LFilePath), nil, LpResultChar);

    if LResult > 32 then begin
      LExeFullPath := LpResultChar;
      Memo1.Lines.Add(TButton(Sender).Name + ' : ' + LExeFullPath);
    end else begin
      Memo1.Lines.Add(TButton(Sender).Name + ' : ' + IntToStr(LResult));
    end;
  finally
    StrDispose(LpResultChar);
  end;
end;

//=============================================================================
//  ファイルのフルパスから、起動するアプリのEXE名を取得
//  文字列バッファとしてString型を使用する例
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LFilePath    : string;
  LExeFullPath : String;
  LResult      : HINST;
  LBuffer      : string;
 begin
  //ファイルのフルパス
  LFilePath := Trim(Edit1.Text);

  //文字列バッファの領域を確保して関数を実行
  SetLength(LBuffer, MAX_PATH + 1);
  LResult := FindExecutable(PChar(LFilePath), nil , @LBuffer[1]);

  if LResult > 32 then begin
    LExeFullPath := LBuffer;
    Memo1.Lines.Add(TButton(Sender).Name + ' : ' + LExeFullPath);
  end else begin
    Memo1.Lines.Add(TButton(Sender).Name + ' : ' + IntToStr(LResult));
  end;
end;

//=============================================================================
//  ファイルのフルパスから、起動するアプリのEXE名を取得
//  文字列バッファとしてChar型の動的配列を使用する例
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LFilePath    : string;
  LExeFullPath : string;
  LBuffer      : array of Char;
  LResult      : HINST;
begin
  //ファイルのフルパス
  LFilePath := Trim(Edit1.Text);

  //文字列バッファの領域を確保して関数を実行
  SetLength(LBuffer, MAX_PATH + 1);
  LResult := FindExecutable(PChar(LFilePath), nil, PChar(LBuffer));

  if LResult > 32 then begin
    LExeFullPath := string(LBuffer);
    Memo1.Lines.Add(TButton(Sender).Name + ' : ' + LExeFullPath);
  end else begin
    Memo1.Lines.Add(TButton(Sender).Name + ' : ' + IntToStr(LResult));
  end;
end;