Ver Mensaje Individual
  #14  
Antiguo 21-08-2018
Avatar de escafandra
[escafandra] escafandra is offline
Miembro Premium
 
Registrado: nov 2007
Posts: 2.197
Reputación: 20
escafandra Tiene un aura espectacularescafandra Tiene un aura espectacular
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.

Última edición por escafandra fecha: 21-08-2018 a las 12:40:47.
Responder Con Cita