procedure TMainFm.Button1Click(Sender: TObject);
Var
  p: PChar;
begin
  p := 'C:\file path\appname.exe';
  ShellExecute(
  0,
  'open',
  p,
  nil,
  nil,
  SW_SHOW);
end;

      procedure TMainFm.Button1Click(Sender: TObject);
      Var  p : string;
        begin
            p := 'C:\file path\appname.exe';
           ShellExecute(0,'open',pchar(p),nil,nil,SW_SHOWNORMAL);
      end;

{************************************************************************}
{*                                                                      *}
{*      file       : Launch.PAS                                         *}
{*                                                                      *}
{*      type       : unit                                               *}
{*                                                                      *}
{*      location   : \QUIRT\SRC\DELPHI                                  *}
{*                                                                      *}
{*      purpose    : Launch external programs                           *}
{*                                                                      *}
{*      author     : Lennert Ploeger (NKI / AVL)                        *}
{*                                                                      *}
{*      date       : 19980325                                           *}
{*                                                                      *}
{*      portability: 32 bit delphi only (V2.0 up)                       *}
{*                                                                      *}
{*      notes      : None                                               *}
{*                                                                      *}
{************************************************************************}
{* Updates:
When            Who     What
19980325        lsp     Created
19980331        lsp     Search for programs in PATH using SearchPath()
19980609        lsp     Allow white-spaces for the program to launch
19980709        lsp     Allow 'prog' to be empty in StartProgram
19980731        lsp     Enclose both file and directory names in double quotes
19980901        lsp     Removed some obsolete functions
19981004        mvh     Added RunProgram (waits until ready)
19981005        mvh     Renamed to RunProgramBlocking (waits until ready)
19981020        lsp     Program launched in RunProgramBlocking() is started
                        minimized and not given focus
19990110        mvh     RunProgramBlocking returns value
19990111        lsp     Fixed comment about CloseHandle()
19990112       	mvh	    Added RunProgramWaiting, shortened code by reuse
19990425        lsp     FileUtil -> QFileUtil
19990609        lsp     Removed QFileUtil dependency
*}
 
unit Launch;
 
interface
 
//Para pasar de ProcId a THandle
type
  TWindowRec = record
    Handle: THandle;
    ProcessId: Cardinal;
    WindowName: PChar;
  end;
  PWindowRec = ^TWindowRec;
 
function LocateProgramInSearchPath(ProgramName: string): string;
procedure StartProgram(prog, workdir: string; params: array of string);
function RunProgramBlocking(prog, workdir: string; params: array of string): integer;
function RunFileBlocking(fichero: string): boolean;
function RunProgramWaiting(prog, workdir: string; params: array of string): integer;
function ProgramStarter(prog, workdir: string; params: array of string; showmode: integer): integer;
//HCSoft...
//Localizar Handler de un proceso a partir del filename del ejecutable
function GetProcHandle(ExeFileName: string): THandle;
//Hacer cosas a partir del THandle...
function KillProc(H: THandle): boolean;
function WaitProcIddle(H: THandle; MinSeg: double = 1; MaxSeg: double = 30): double;
//Hacer cosas a partir del FileName...
function WaitExeIddle(ExeFileName: string; MinSeg: double = 0.1; MaxSeg: double = 10): double;
function KillTask(ExeFileName: string): boolean;
 
implementation
 
uses
  SysUtils, Dialogs, Windows, Forms, FileCtrl, ShellAPI, HCBase, Tlhelp32;
 
 
// Routine to retrieve file information using a file/dirname
function FileDirNameWin32FindData(FullPathName: string; var Win32FindData: TWin32FindData): boolean;
var
  Handle: THandle;
begin
  Handle := FindFirstFile(PChar(FullPathName), Win32FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    Result := True;
  end
  else
    Result := False;
end;
 
// Search for 'ProgramName' in %PATH% using Win API function 'SearchPath'
function LocateProgramInSearchPath(ProgramName: string): string;
type
  BufType = array[0..255] of char;
var
  SPPath: BufType;
  PathPtr: PChar;
begin
  if SearchPath(nil, PChar(ProgramName), nil, 255, SPPath, PathPtr)>0 then
    Result := StrPas(SPPath)
  else
    Result := ProgramName;
end;
 
function TestExistence(const Name: string): boolean;
begin
  Result := FileExists(Name) or DirectoryExists(Name);
end;
 
// Internal common code for the 3 exported program starters
 
function ProgramStarter(prog, workdir: string;
                        params: array of string; showmode: integer): integer;
var
  StartInf : TStartupInfo;
  ProcInf  : TProcessInformation;
  args     : string;
  progtmp  : string;
  pAppName : PChar;
  pworkdir : PChar;
  i        : integer;
begin
  // It appears that it is also possible to call ShellExecute, what seems
  // to be a bit a higher level function:
  // ShellExecute(handle, "open", path_to_file, NULL, NULL, SW_SHOWNORMAL);
  // Another alternative can be calling WinExec, but with the drawback of
  // not having the possibility to specify the work directory.
 
  ZeroMemory(@StartInf, sizeof(TStartupInfo));
  ZeroMemory(@ProcInf, sizeof(TProcessInformation));
  StartInf.cb      := sizeof(TStartupInfo);
  StartInf.dwFlags := STARTF_USESHOWWINDOW ;
  StartInf.wShowWindow := showmode;
 
  // To call CreateProcess() we should be carefull to enclose files
  // passed in 'lpCommandLine' in double quotes ('"') to make sure that
  // it understands where one starts and ends. The pecularity is that the
  // name of the executable should NOT be enclosed in double quotes. Passing
  // both the file and the arguments in lpCommandLine and leaving
  // lpApplicationName empty is no option, since the application and
  // arguments should be white-space delimited that way.
 
  progtmp := prog;
  if not FileExists(progtmp) then
    progtmp := LocateProgramInSearchPath(progtmp);
 
  if Length(prog)>0 then
    args := '"' + prog + '"';
  for i:=low(params) to high(params) do
  begin
    // Enclose file and directory names in double quotes to get them seperated properly
    if TestExistence(params[i]) then
    begin
      if Length(args)>0 then // Try to add spaces only when necessary
        args := args + ' "' + params[i] + '"'
      else
        args := '"' + params[i] + '"'
    end
    else if Length(params[i])>0 then
    begin
      if Length(args)>0 then // Try to add spaces only when necessary
        args := args + ' ' + params[i]
      else
        args := params[i];
    end;
  end;
 
  if Length(workdir)>0 then
    pworkdir := PChar(workdir)
  else
    pworkdir := nil;
 
  if Length(progtmp)>0 then
    pAppName := PChar(progtmp)
  else
    pAppName := nil;
 
  if not CreateProcess(pAppName, PChar(args), nil, nil, False, 0, nil,
    pworkdir, StartInf, ProcInf) then
    MessageDlg('El programa ' + prog + ' no ha podido ser ejecutado', mtError, [mbOk], 0);
 
  // The handles for both the process and the main thread must be closed through
  // calls to CloseHandle. These handles are not needed, so it is best to close
  // them immediately after the process is created.
  result := ProcInf.hProcess;
  CloseHandle(ProcInf.hThread);
end;
 
// routine to start program 'prog' using the file-parameters in 'params'.
// Be carefull with passing [] for the params, since the stackpointer seems
// to get corrupt. However, starting a program with no arguments can be done
// using StartProgram(program, workdir, [ ' ' ]).
procedure StartProgram(prog, workdir: string; params: array of string);
var
  hProcess: integer;
begin
  hProcess := ProgramStarter(prog, workdir, params, SW_SHOWDEFAULT);
  CloseHandle(hProcess);
end;
 
// routine to run program 'prog' using the file-parameters in 'params'.
// and wait until it is finished
// Be careful with passing [] for the params, since the stackpointer seems
// to get corrupt. However, starting a program with no arguments can be done
// using StartProgram(program, workdir, [ ' ' ]).
function RunProgramBlocking(prog, workdir: string; params: array of string): integer;
var
  hProcess: integer;
  j       : Cardinal;
begin
  hProcess := ProgramStarter(prog, workdir, params, SW_SHOWMINNOACTIVE);
 
  WaitForSingleObject(hProcess, INFINITE);
  GetExitCodeProcess(hProcess, j);
  result := integer(j);
 
  CloseHandle(hProcess);
end;
 
function RunFileBlocking(fichero: string): boolean;
var
  SEI: TShellExecuteInfo;
begin
  //Ejecuto el fichero con el programa adecuado...
  FillChar(SEI, SizeOf(SEI), 0); // Wipe the record to start with
  Result:= true;
  with SEI do
  begin
    cbSize := SizeOf(SEI);
    fMask := see_Mask_NoCloseProcess;
    Wnd := Application.MainForm.Handle;
    lpVerb := 'open';
    lpFile := PAnsiChar(fichero);
    lpDirectory := PChar(ExtractFilePath(fichero));
    nShow := sw_ShowNormal;
    if not ShellExecuteEx(@SEI) then
      Result:= False;
  end;
  //Espero a que liberen el fichero...
 
  //WaitForSingleObjet no se debe usar si se va a abrir una ventana porque
  //el proceso que llama deja de procesar mensajes y la ventana nueva cuelga:
  //http://msdn.microsoft.com/en-us/library/ms687032%28VS.85%29.aspx
  while WaitForSingleObject(SEI.hProcess, 100) = WAIT_TIMEOUT do
    Application.ProcessMessages;
end;
 
// routine to run program 'prog' using the file-parameters in 'params'.
// and wait until it is finished. During the wait, however, messages are
// processed so that the user interface remains 'live'.
function RunProgramWaiting(prog, workdir: string; params: array of string): integer;
var
  hProcess: integer;
  j        : Cardinal;
begin
  hProcess := ProgramStarter(prog, workdir, params, SW_SHOWMINNOACTIVE);
  while WaitForSingleObject(hProcess, 10) = WAIT_TIMEOUT do
    Application.ProcessMessages;
  GetExitCodeProcess(hProcess, j);
  result := integer(j);
  CloseHandle(hProcess);
end;
 
 
// **************************************************************************
// ** AÑADIDO SERGIO PARA MENEJAR PROCESOS POR SU HANDLE O SU EXE FILENAME **
// **************************************************************************
 
function FileTime2Milliseconds(FileTime: TFileTime): integer;
var ST: TSystemTime;
begin
  FileTimeToSystemTime(FileTime, ST);
  result:= ST.wMilliseconds + 1000 *
          (ST.wSecond + 60 * (ST.wMinute + 60 * ST.wHour)) ;
end;
 
//Sabemos 'WINWORD.EXE', dame un THandle del proceso para hacerle putadillas
function GetProcHandle(ExeFileName: string): THandle;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  result:= 0;
  FSnapshotHandle:= CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize:= Sizeof(FProcessEntry32);
  ContinueLoop:= Process32First(FSnapshotHandle, FProcessEntry32);
  while integer(ContinueLoop) <> 0 do begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExeFileName))
     or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName))) then begin
      result:= OpenProcess(PROCESS_ALL_ACCESS, FALSE, FProcessEntry32.th32ProcessID);
      break;
    end;
    ContinueLoop:= Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;
 
//Mata este proceso!
function KillProc(H: THandle): boolean;
const PROCESS_TERMINATE=$0001;
begin
  result:= (Integer(TerminateProcess(H, 0))<>0);
end;
 
//Espera a que un Proceso use menos del 1% de la CPU.
//Si no encuentra el proceso, esperara MinSeg, y si lo encuentra pero no baja
//del 1%, se esperara un maximo de MaxSeg.
function WaitProcIddle(H: THandle; MinSeg: double = 1; MaxSeg: double = 30): double;
var
  LastProcTime, NewProcTime, UsedTime: integer; //Milisegundos todo
  CreaTime, ExitTime, UserTime, KernelTime: TFileTime;
const
  WAIT_FOR_MS: integer = 1000; //Cada 1 segundo (1000 ms) vuelves a mirar
  IDDLE_LOWER: integer =    5; //Usados < 5 ms = (%CPU<0.5) salimos
begin
  //Llevo esperando 0 segundos...
  result:= 0;
  //Igual no lo encuentro...
  if (H=0) then begin
    //Pues no esta, espero algo y me voy...
    sleep(round(MinSeg*1000));
  end else begin
    //Proceso encontrado, a esperar...
    if GetProcessTimes(H, CreaTime, ExitTime, KernelTime, UserTime)=BOOL(0) then exit;
    LastProcTime:= FileTime2Milliseconds(KernelTime) + FileTime2Milliseconds(UserTime);
    //Cada decima de segundo, recalculo...
    repeat
      sleep(WAIT_FOR_MS);
      result:= result + (WAIT_FOR_MS/1000);
      //Rescato tiempo dle proceso actualizado...
      if GetProcessTimes(H, CreaTime, ExitTime, KernelTime, UserTime)=BOOL(0) then exit;
      NewProcTime:= FileTime2Milliseconds(KernelTime) + FileTime2Milliseconds(UserTime);
      UsedTime:= (NewProcTime - LastProcTime);
      if (UsedTime) < IDDLE_LOWER then
        break;
      LastProcTime:= NewProcTime;
    until (result >= MaxSeg);
  end;
end;
 
// ***************************************************
// ** MANEJO PROCESOS SABIENDO SU NOMBRE DE FICHERO **
// ***************************************************
 
//Espera a que una tarea baje del 1%CPU usando su filename
function WaitExeIddle(ExeFileName: string; MinSeg: double = 0.1; MaxSeg: double = 10): double;
begin
  result:= WaitProcIddle(GetProcHandle(ExeFileName), MinSeg, MaxSeg);
end;
 
//Mata programa por su nombre...
function KillTask(ExeFileName: string): boolean;
begin
  result:= KillProc(GetProcHandle(ExeFileName));
end;
 
end.