Código fuente en Delphi para mostrar la ruta y el fichero ejecutable que abre un fichero especificado. Permite también abrir tanto el fichero como la aplicación que lo ejecuta.

Para ello hemos utilizado dos TEdit y cuatro TButton. En el Uses del formulario deberemos añadir la unidad "shellapi":

unit UnidadMenuPrincipal;

interface

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

type
  TformMenuPrincipal = class(TForm)
    bBuscarAsociacion: TButton;
    Label1: TLabel;
    txtFichero: TEdit;
    OpenDialog1: TOpenDialog;
    bSeleccionarFichero: TButton;
    txtAplicacion: TEdit;
    bEjecutar: TButton;
    bAbrir: TButton;
    LWEB: TLabel;
    procedure bBuscarAsociacionClick(Sender: TObject);
    procedure bSeleccionarFicheroClick(Sender: TObject);
    procedure bEjecutarClick(Sender: TObject);
    procedure bAbrirClick(Sender: TObject);
    procedure LWEBClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  formMenuPrincipal: TformMenuPrincipal;

implementation

{$R *.dfm}

function aplicacionAsociadaFichero (fichero : string) : string;
var
  app: array[1..250] of Char;
  i: Integer;
  DefaultDir: string;
  cmd : String;
begin
  if FileExists(fichero) then
  begin
    DefaultDir := GetCurrentDir;
    FillChar(app, SizeOf(app), ' ');
    app[250] := #0;
    i := FindExecutable(@fichero[1], @DefaultDir[1], @app[1]);
    if i <= 32 then
      Result := 'No tiene asociación'
    else
      Result := app;
  end
  else
    result := 'Fichero no encontrado';
end;

procedure TformMenuPrincipal.bBuscarAsociacionClick(Sender: TObject);
begin
  txtAplicacion.Text := aplicacionAsociadaFichero(txtFichero.Text);
end;

procedure TformMenuPrincipal.bSeleccionarFicheroClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    txtFichero.Text := OpenDialog1.FileName;
    bBuscarAsociacionClick(sender);
  end;
end;

procedure TformMenuPrincipal.bEjecutarClick(Sender: TObject);
begin
  ShellExecute(Handle, Nil, PChar(txtAplicacion.Text),
      Nil, Nil, SW_SHOWNORMAL);
end;

procedure TformMenuPrincipal.bAbrirClick(Sender: TObject);
begin
  ShellExecute(Handle, Nil, PChar(txtFichero.Text),
      Nil, Nil, SW_SHOWNORMAL);
end;

procedure TformMenuPrincipal.LWEBClick(Sender: TObject);
begin
  ShellExecute(Handle, Nil, PChar(LWEB.CAPTION),
      Nil, Nil, SW_SHOWNORMAL);
end;

end.

Publicado el: 2005-05-07