Gestionar archivos temporales que se abren con terceros programas

[Casimiro Noteví]

Empezado por newtron

Andalaleche.... pensaba que esto del "RunAndWaitShell" dejaba "pillado" al programa hasta que no cerrara el visor.
Gracias y un saludo

No, por eso decía que podías borrarlo al "regresar".

[[escafandra]]

He visto alguna implementacion de RunAndWaitShell y personalemnte no me gustan mucho. Para no bloquear la app usan la chapuza de ProcessMessages y el flujo de la app puede quedar descontrolado. Prefiero que ShellExecuteEx sea bloqueante hasta terminar la ejecución, pero en un Thread. Tras terminar, el hilo envía un mensaje a la ventana que indicará el fin de la ejecución.

Código Delphi [-]
procedure RunAndWaitShell(Handle: THandle; Operation, FileName, Parameters, Directory: String; nShowCmd: INTEGER);
function ThRunAndWaitShell(var Info: TShellExecuteInfo): BOOL; stdcall;
begin
  ShellExecuteExA(@Info);
  WaitForSingleObject(Info.hProcess, INFINITE);
  SendMessage(Info.wnd, RS_FINISH, 0, 0);
end;
const
{$J+}
  Info: TShellExecuteInfo = ();
begin
  with Info do
  begin
    cbSize:= SizeOf(Info);
    fMask:= SEE_MASK_NOCLOSEPROCESS;
    wnd:= Handle;
    lpVerb:= PAnsiChar(Operation);
    lpFile:= PAnsiChar(FileName);
    lpParameters:= PAnsiChar(Parameters + #0);
    lpDirectory:= PAnsiChar(Directory);
    nShow:= nShowCmd;
    hInstApp:= 0;
  end;
  CloseHandle(CreateThread(nil, 0, @ThRunAndWaitShell, @Info, 0, PDWORD(0)^));
{$J-}
end;

Un ejemplo:

Código Delphi [-]
unit Unit1;

interface

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

const
  RS_FINISH = WM_USER + 1;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    procedure OnRunAndWaitShell(var Msg: TMessage); message RS_FINISH;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure RunAndWaitShell(Handle: THandle; Operation, FileName, Parameters, Directory: String; nShowCmd: INTEGER);
function ThRunAndWaitShell(var Info: TShellExecuteInfo): BOOL; stdcall;
begin
  ShellExecuteExA(@Info);
  WaitForSingleObject(Info.hProcess, INFINITE);
  SendMessage(Info.wnd, RS_FINISH, 0, 0);
end;
const
{$J+}
  Info: TShellExecuteInfo = ();
begin
  with Info do
  begin
    cbSize:= SizeOf(Info);
    fMask:= SEE_MASK_NOCLOSEPROCESS;
    wnd:= Handle;
    lpVerb:= PAnsiChar(Operation);
    lpFile:= PAnsiChar(FileName);
    lpParameters:= PAnsiChar(Parameters + #0);
    lpDirectory:= PAnsiChar(Directory);
    nShow:= nShowCmd;
    hInstApp:= 0;
  end;
  CloseHandle(CreateThread(nil, 0, @ThRunAndWaitShell, @Info, 0, PDWORD(0)^));
{$J-}
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  RunAndWaitShell(Handle, 'open', 'Archivo.txt', '', '', SW_SHOW);
end;

procedure TForm1.OnRunAndWaitShell(var Msg: TMessage);
begin
  // Fin de ejecución
  ShowMessage('Fin');
end;

end.

El sistema puede complicarse un poco más si queremos ejecutar varios Trheads al mismo tiempo para identificar cual de ellos se cierra y así controlar que visor se cerró.


Saludos.

[[escafandra]]

Como me parece que newtron comentaba que le pedían varios visores a la vez, ha modifocado un poquito el código para que RunAndWaitShell devuelva el ThreadId que ejecuta cada vez que será enviado de vuelta mediante el mensaje de finalizacion del vosor concreto. De esta forma tenemos identificado el proceso que se cierra cuyo ThreadId corresponde al que obtuvimos al iniciarlo.


Pongo Un ejemplo con las modificaciones:

Código Delphi [-]
unit Unit1;

interface

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

const
  RS_FINISH = WM_USER + 1;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    procedure OnRunAndWaitShell(var Msg: TMessage); message RS_FINISH;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function RunAndWaitShell(Handle: THandle; Operation, FileName, Parameters, Directory: String; nShowCmd: Integer): DWORD;
function ThRunAndWaitShell(var Info: TShellExecuteInfoA): BOOL; stdcall;
begin
  ShellExecuteExA(@Info);
  WaitForSingleObject(Info.hProcess, INFINITE);
  SendMessage(Info.wnd, RS_FINISH, GetCurrentThreadId, 0);
end;
const
{$J+}
  Info: TShellExecuteInfoA = ();
begin
  with Info do
  begin
    cbSize:= SizeOf(Info);
    fMask:= SEE_MASK_NOCLOSEPROCESS;
    wnd:= Handle;
    lpVerb:= PAnsiChar(Operation);
    lpFile:= PAnsiChar(FileName);
    lpParameters:= PAnsiChar(Parameters + #0);
    lpDirectory:= PAnsiChar(Directory);
    nShow:= nShowCmd;
    hInstApp:= 0;
  end;
  CloseHandle(CreateThread(nil, 0, @ThRunAndWaitShell, @Info, 0, Result));
{$J-}
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Label1.Caption:= IntToStr(RunAndWaitShell(Handle, 'open', 'd:/Archivo1.txt', '', '', SW_SHOW));
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Label2.Caption:= IntToStr(RunAndWaitShell(Handle, 'open', 'd:/Archivo2.pdf', '', '', SW_SHOW));
end;

procedure TForm1.OnRunAndWaitShell(var Msg: TMessage);
begin
  // Fin de ejecución
  ShowMessage('Fin ' + IntToStr(Msg.WParam));
end;

end.

Espero que con esto quede soluicionada la duda.


Saludos.

[Casimiro Noteví]

Muy bueno. Me lo copio
Lo del processmessages es un poco chapucilla, sí.

[[gatosoft]]

Solo para el registro... si quisiera comprobar si un archivo se encuentra en uso, podrías probar con el código:

Código Delphi [-]
function FileIsInUse(aName : string) : boolean;
var
    HFileRes : HFILE;
begin
  if FileExists(aName) then
  begin
    HFileRes := CreateFile(pchar(aName), GENERIC_READ or
      GENERIC_WRITE,0, nil,
      OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL, 0);
    Result := (HFileRes = INVALID_HANDLE_VALUE);
    _lclose(HFileRes);
  end
  else
    Result := false;
end;

[Casimiro Noteví]

Me lo copio también
Excelente utilidad.

[[escafandra]]

Ese código se puede resumir puesot que no es necesario comprobar si el fichero existe. CreateFile ya lo hace:

Código Delphi [-]
function FileIsInUse2(aName : string) : boolean;
var
  HFileRes: HFILE;
begin
  HFileRes := CreateFile(pchar(aName), GENERIC_READ,0, nil, OPEN_EXISTING, 0, 0);
  Result := (HFileRes = INVALID_HANDLE_VALUE);
  _lclose(HFileRes);
end;

Saludos.