API - executar programa com CreateProcess

//A Microsoft aconselha a usar CreateProcess ao invés de WinExec

//--------------------------------------------------------------

// Funcao para executar um programa DOS e aguardar ate que o mesmo termine (testado em Win2000 server, Win98SE e WinXP)

// exemplo: if WinExecWait('c:\market\super', 'c:\market\super\arj.exe', 'a a c:\teste.arj c:\frente\*.exe > c:\log.txt' {a c:\Teste c:\Frente\*.* -r -x*.DBF'}, SW_SHOWMINIMIZED) then

function ExecDOSWait(const WorkDir, ExecutableFile: string; Params: string = ''; WindowStyle: LongWord = SW_SHOWNORMAL): Boolean;

var

  p      : TProcessInformation;

  s      : TStartupInfo;

  R      : Cardinal;

  PParams: PChar;

  RetVar : boolean;

  CDir   : string;

  w98str : string;

begin

   CDir          := GetCurrentDir;

   s.cb          := SizeOf(TStartupInfo);

   s.wShowWindow := WindowStyle;

   s.lpDesktop   := nil;

   s.dwFlags     := STARTF_USESHOWWINDOW;

   s.lpReserved  := nil;

   s.lpTitle     := nil;

   s.cbReserved2 := 0;

   s.lpReserved2 := nil;

   if Trim(WorkDir) <> '' then SetCurrentDir(WorkDir);

   // para Windows9x

   if Win32Platform <> VER_PLATFORM_WIN32_NT then

   begin

     w98str := 'c:\command.com /c ' + ExecutableFile + #32 + StrTran(Params,'|','');

     if not CreateProcess(nil, PChar(w98str), nil, nil, false,

                          Create_New_Console or Normal_Priority_Class, nil, Pchar(WorkDir), s, p) then Result:= False

     else

     begin

       WaitForSingleObject(P.hProcess,INFINITE);

       GetExitCodeProcess(P.hProcess,R);

       Result := True;

     end;

     Exit;

   end;

   if trim(Params) = '' then

      PParams := nil

   else

   begin

      if Params[1] <> ' ' then Params := ' ' + Params;

      PParams := PChar(Params);

   end;

   if CreateProcess(PChar(ExecutableFile),PParams,nil,nil,true,0,nil,nil,s,p) then

   begin

     WaitForSingleObject(p.hProcess,INFINITE);

     CloseHandle(p.hProcess);

     CloseHandle(p.hThread);

     RetVar := true;

   end

   else

      RetVar := false;

   Result := Retvar;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

  if WinExecWait('c:\market\super', 'c:\market\super\arj.exe', 'a a c:\teste.arj c:\frente\*.exe > c:\log.txt' {a c:\Teste c:\Frente\*.* -r -x*.DBF'}, SW_SHOWMINIMIZED) then

    Color := clGReen

  else

    Color := clRed;

end;

////////////// antigos:

// Funcao para executar um programa DOS e aguardar ate que o mesmo termine

// Que merda

function ExecDOSWait(const Parametros: string; WorkPath: string = ''; ShowWindow: Word = SW_HIDE): Integer;

var

  R          : DWORD;

  StartUpInfo: TStartUpInfo;

  ProcessInfo: TProcessInformation;

begin

  FillChar(StartUpInfo,SizeOf(StartUpInfo),#0);

  StartUpInfo.Cb      := SizeOf(StartUpInfo);

  StartUpInfo.DwFlags := StartF_UsesHowWindow;

  //StartUpInfo.wShowWindow:= SW_SHOWNORMAL; // Mostra tela do DOS

  StartUpInfo.wShowWindow := ShowWindow; // Oculta a tela do DOS

  if not CreateProcess(nil, PChar(Parametros), nil, nil, false,

                       Create_New_Console or Normal_Priority_Class, nil, Pchar(WorkPath), StartUpInfo, ProcessInfo) then Result:= -1

  else

  begin

    WaitForSingleObject(ProcessInfo.hProcess,INFINITE);

    GetExitCodeProcess(ProcessInfo.hProcess,R);

    Result := R;

  end;

end;

////////////////////////// ORIGINAL ///////////////////////

// Executa um programa

function WinExec32(const Linha_de_Comando: string; Parametros: string = ''): Boolean;

var

  StartUpInfo: TStartUpInfo;

  ProcessInfo: TProcessInformation;

begin

  FillChar(StartUpInfo,SizeOf(StartUpInfo),#0);

  StartUpInfo.Cb         := SizeOf(StartUpInfo);

  StartUpInfo.DwFlags    := StartF_UsesHowWindow;

  StartUpInfo.wShowWindow:= SW_SHOWNORMAL;

  Result := CreateProcess(PChar(Linha_de_Comando), PChar(Parametros), nil, nil, False,

                          Create_New_Console or Normal_Priority_Class, nil, nil, StartUpInfo, ProcessInfo);

end;

// Executa um programa e espera ele terminar

function WinExecAndWait32(const Linha_de_Comando: string; Parametros: string = ''): Integer;

var

  R          : DWORD;

  StartUpInfo: TStartUpInfo;

  ProcessInfo: TProcessInformation;

begin

  FillChar(StartUpInfo,SizeOf(StartUpInfo),#0);

  StartUpInfo.Cb         := SizeOf(StartUpInfo);

  StartUpInfo.DwFlags    := StartF_UsesHowWindow;

  StartUpInfo.wShowWindow:= SW_SHOWNORMAL;

  if not CreateProcess(PChar(Linha_de_Comando), PChar(Parametros), nil, nil, false,

                       Create_New_Console or Normal_Priority_Class, nil, nil, StartUpInfo, ProcessInfo) then Result:= -1

  else

  begin

    WaitForSingleObject(ProcessInfo.hProcess,INFINITE);

    GetExitCodeProcess(ProcessInfo.hProcess,R);

    Result := R;

  end;

end;