Lenguaje de programación Borland Delphi
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