🚀 go-pugleaf

Perhaps this will help:

type
  TCreateNewProcessPriorityClass        = (
    pcInheritCurrent,
    pcAboveNormal,
    pcBelowNormal,
    pcHigh,
    pcIdle,
    pcNormal,
    pcRealTime
  );

  TCreateNewProcessWait = (
    pwNoWait,
    pwWaitUntilEnd,
    pwWaitUntilInputIdle
  );

procedure __WaitForProcessTermination (Pid : LongWord);
var
  Msg   : TMsg;
  r     : LongWord;
begin
  repeat
    r := MsgWaitForMultipleObjects (1, Pid, FALSE, INFINITE, QS_PAINT or
      QS_SENDMESSAGE);
    if r = WAIT_FAILED then
      Exit;
    if r = (WAIT_OBJECT_0 + 1) then
      while PeekMessage(Msg, 0, WM_PAINT, WM_PAINT, PM_REMOVE) do
        DispatchMessage (Msg);
  until (r = WAIT_OBJECT_0);
end;

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

//
// Code adapted from WinExecAndWaitV2 by Peter Below from Team B on Delphi
ng's
//
function CreateNewProcess (const CommandLine : string;
  const ShowWindow : Word; const Wait : TCreateNewProcessWait;
  const Priority : TCreateNewProcessPriorityClass;
  const WaitIdleTimeoutMs : LongWord; Pid, ThreadId : PLongWord) : LongWord;
var
  StartInfo     : TStartupInfo;
  ProcInfo      : TProcessInformation;
  Cf            : LongWord;
begin
  Result := LongWord(-1);

  FillChar (StartInfo, SizeOf(StartInfo), 0);
  FillChar (ProcInfo, SizeOf(ProcInfo), 0);
  StartInfo.cb := SizeOf(StartInfo);

  if ShowWindow <> 0 then
  begin
    StartInfo.dwFlags := STARTF_USESHOWWINDOW;
    StartInfo.wShowWindow := ShowWindow;
  end;

  case Priority of
    pcInheritCurrent    : Cf := GetPriorityClass (GetCurrentProcess);
    pcAboveNormal       : Cf := ABOVE_NORMAL_PRIORITY_CLASS;
    pcBelowNormal       : Cf := BELOW_NORMAL_PRIORITY_CLASS;
    pcHigh              : Cf := HIGH_PRIORITY_CLASS;
    pcIdle              : Cf := IDLE_PRIORITY_CLASS;
    pcNormal            : Cf := NORMAL_PRIORITY_CLASS;
    pcRealTime          : Cf := REALTIME_PRIORITY_CLASS;
    else
      Cf := 0;
  end;

  Cf := Cf or CREATE_NEW_CONSOLE;

  if CreateProcess(nil, PChar(CommandLine), nil, nil, FALSE, Cf, nil, nil,
    StartInfo, ProcInfo) then
  begin
    case Wait of
      pwNoWait  :
      begin
        if Assigned(Pid) then
          Pid^ := ProcInfo.hProcess;
        if Assigned(ThreadId) then
          ThreadId^ := ProcInfo.hThread;

        Result := ProcInfo.hProcess;
      end;

      pwWaitUntilEnd    :
      begin
        __WaitForProcessTermination (ProcInfo.hProcess);
        GetExitCodeProcess (ProcInfo.hProcess, Result);
        CloseHandle (ProcInfo.hProcess);
        CloseHandle (ProcInfo.hThread);
      end;

      pwWaitUntilInputIdle      :
      begin
        WaitForInputIdle (ProcInfo.hProcess, WaitIdleTimeoutMs);
        if Assigned(Pid) then
          Pid^ := ProcInfo.hProcess;
        if Assigned(ThreadId) then
          ThreadId^ := ProcInfo.hThread;

        Result := ProcInfo.hProcess;
      end;
    end;        // case Wait
  end;
end;

"Mike Fieger" <mike.fieger@aon.at> wrote in message
news:401592fe@newsgroups.borland.com...
> Hello!
>
> I need to start a DOS-program and redirect its output to a file from
within
> a Delphi application.
> After some trying I created the following code.
> Everything works fine... except for the fact that it stops working as soon
> as I try to actually redirect the output to a file...   :-(
>
> Can anybody help me with that?
>
> Mike
>
>
>
>
> procedure TForm1.StartDosProg;
> var
>   StartupInfo: TStartupInfo;         // for CreateProcess
>   ProcessInfo: TProcessInformation;  // for CreateProcess
> begin
>   // Initialize StartupInfo
>   FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
>   StartupInfo.cb := Sizeof(TStartupInfo);
>   StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
>   StartupInfo.wShowWindow := SW_SHOWNORMAL;
>   // Start DOS-prog
>   if CreateProcess(nil, PChar('fc'), nil, nil, false,
NORMAL_PRIORITY_CLASS,
> nil, nil, StartupInfo, ProcessInfo) then   // this works
>   //if CreateProcess(nil, PChar('fc >fc.log'), nil, nil, false,
> NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo) then  // this
> works not :-(   why?
>   begin
>     // Program started: Wait till finished...
>     WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
>     CloseHandle(ProcessInfo.hProcess);
>   end
>   else
>   begin
>     // Error starting program
>     //Application.MessageBox(PChar(sGetErrorString(GetLastError)),
'Error',
> MB_OK);
>   end;
> end;
>
>