jvqcreateprocess.pas

East make Tray Icon in delphi

destructor TJvCreateProcess.Destroy;
begin
  TerminateWaitThread;
  //  CloseProcessHandles;
  FreeAndNil(FEndLock);
  FreeAndNil(FEnvironment);
  FreeAndNil(FStartupInfo);
  if FHandle <> 0 then
    DeallocateHWndEx(FHandle);
  inherited Destroy;
  FConsoleOutput.Free;
end;

procedure TJvCreateProcess.CheckNotWaiting;
begin
  if FState = psWaiting then
    raise EJvProcessError.CreateRes(@RsEProcessIsRunning);
end;

procedure TJvCreateProcess.CheckRunning;
begin
  if FState = psReady then
    raise EJvProcessError.CreateRes(@RsEProcessNotRunning);
end;

function TJvCreateProcess.CloseApplication(SendQuit: Boolean): Boolean;
begin
  CheckRunning;
  Result := InternalCloseApp(ProcessInfo.dwProcessId, SendQuit);
end;

procedure TJvCreateProcess.CloseProcessHandles;
begin
  OSCheck(SafeCloseHandle(FProcessInfo.hProcess));
  OSCheck(SafeCloseHandle(FProcessInfo.hThread));
end;

procedure TJvCreateProcess.CloseRead;
begin
  if FReadThread is TJvReadThread then
    TJvReadThread(FReadThread).CloseRead;
end;

procedure TJvCreateProcess.CloseWrite;
begin
  if FWaitThread is TJvConsoleThread then
    TJvConsoleThread(FWaitThread).CloseWrite;
end;

procedure TJvCreateProcess.ConsoleWaitThreadTerminated(Sender: TObject);
var
  AllThreadsDone: Boolean;
begin
  StartConsoleEnding;
  try
    if Assigned(FReadThread) then
      TJvReadThread(FReadThread).TerminateThread;

    FExitCode := TJvWaitForProcessThread(Sender).FExitCode;

    { We only fire a TerminateEvent if both the read thread and the wait thread
      have terminated; usually the read thread will terminate before the wait
      thread; must be determined inside the lock (FEndLock) }
    AllThreadsDone := FReadThread = nil;

    // Indicates that the wait thread is done; must bo set inside lock.
    FWaitThread := nil;
  finally
    EndConsoleEnding;
  end;

  if AllThreadsDone then
    DoTerminateEvent;
end;

procedure TJvCreateProcess.DoRawReadEvent(Data: PChar; const ASize: Cardinal);
var
  S: string;
begin
  if Assigned(FOnRawRead) then
  begin
    // Do copy because of possible #0's etc.
    SetLength(S, ASize);
    Move(Data^, PChar(S)^, ASize);
    FOnRawRead(Self, S);
  end;
end;

procedure TJvCreateProcess.DoReadEvent(const EndsWithNewLine: Boolean);
begin
  // Notify user and update current line & cursor
  if not (coOwnerData in ConsoleOptions) then
  begin
    if FStartsOnNewLine or (ConsoleOutput.Count = 0) then
      ConsoleOutput.Add(FCurrentLine)
    else
      ConsoleOutput[ConsoleOutput.Count - 1] := FCurrentLine;
  end;
  if Assigned(FOnRead) then
    FOnRead(Self, FCurrentLine, FStartsOnNewLine);
  if EndsWithNewLine then
  begin
    FCurrentLine := '';
    FCursorPosition := 0;
  end;
  FStartsOnNewLine := EndsWithNewLine;
end;

procedure TJvCreateProcess.DoTerminateEvent;
begin
  FState := psReady;
  FreeAndNil(FEndLock);
  CloseProcessHandles;
  if Assigned(FOnTerminate) then
    FOnTerminate(Self, FExitCode);
end;

procedure TJvCreateProcess.EndConsoleEnding;
begin
  FEndLock.Leave;
end;

function TJvCreateProcess.GetConsoleOutput: TStrings;
begin
  Result := FConsoleOutput;
end;

function TJvCreateProcess.GetEnvironment: TStrings;
begin
  Result := FEnvironment;
end;

function TJvCreateProcess.GetHandle: THandle;
begin
  if FHandle = 0 then
    FHandle := AllocateHWndEx(WndProc);
  Result := FHandle;
end;

procedure TJvCreateProcess.HandleReadEvent;
var
  ASize: Cardinal;
begin
  { Copy the data from the read thread to the this (main) thread and
    parse the console output }
  if FReadThread is TJvReadThread then
    while Assigned(FReadThread) and
      TJvReadThread(FReadThread).ReadBuffer(FParseBuffer, ASize) do
      ParseConsoleOutput(FParseBuffer, ASize);
end;

procedure TJvCreateProcess.ParseConsoleOutput(Data: PChar; ASize: Cardinal);
var
  P, Q: PChar;

  procedure DoOutput;
  { Copy chunk [Q..P) to the current line & Update cursor position }
  var
    ChunkSize: Integer;
  begin
    ChunkSize := P - Q;
    if ChunkSize <= 0 then
      Exit;

    // Does the chunck fit on the current line..
    if Length(FCurrentLine) < FCursorPosition + ChunkSize then
      // .. if not resize current line
      SetLength(FCurrentLine, FCursorPosition + ChunkSize);

    // Move the chunk to the current line
    Move(Q^, (PChar(FCurrentLine) + FCursorPosition)^, ChunkSize);

    // Update the cursor
    Inc(FCursorPosition, ChunkSize);
  end;

  procedure DoTab;
  begin
    // Does the chunck (8 spaces) fit on the current line..
    if Length(FCurrentLine) < FCursorPosition + 8 then
      // .. if not resize current line }
      SetLength(FCurrentLine, FCursorPosition + 8);

    // Fill 8 spaces on the currentline at the cursor position
    FillChar((PChar(FCurrentLine) + FCursorPosition)^, 8, #32);

    // Update the cursor
    Inc(FCursorPosition, 8);
  end;

begin
  DoRawReadEvent(Data, ASize);

  P := Data;
  Q := Data;

  while Cardinal(P - Data) < ASize do
    case P^ of
      #0, #7: // NULL and BELL
        begin
          // Replace with space 
          P^ := #32;
          Inc(P);
        end;
      Backspace:
        begin
          DoOutput;
          Dec(FCursorPosition);
          if FCursorPosition < 0 then
            FCursorPosition := 0;
          Inc(P);
          Q := P;
        end;
      Tab:
        begin
          // Replace with 8 spaces
          DoOutput;
          DoTab;
          Inc(P);
          Q := P;
        end;
      Lf:
        begin
          DoOutput;
          DoReadEvent(True);
          Inc(P);
          Q := P;
        end;
      Cr:
        begin
          DoOutput;
          FCursorPosition := 0;
          Inc(P);
          Q := P;
        end;
    else
      Inc(P);
    end;
  DoOutput;
  DoReadEvent(False);
end;

procedure TJvCreateProcess.ReadThreadTerminated(Sender: TObject);
var
  AllThreadsDone: Boolean;
begin
  StartConsoleEnding;
  try
    // Read for the last time data from the read thread
    HandleReadEvent;
    if FCurrentLine <> '' then
      DoReadEvent(False);

    { We only fire a TerminateEvent if both the read thread and the wait thread
      have terminated; usually the read thread will terminate before the wait
      thread; must be determined inside the lock (FEndLock) }
    AllThreadsDone := FWaitThread = nil;

    // Indicates that the wait thread is done; must bo set inside lock.
    FReadThread := nil;
  finally
    EndConsoleEnding;
  end;

  if AllThreadsDone then
    DoTerminateEvent;
end;

procedure TJvCreateProcess.Run;
const
  CreationFlagsValues: array [TJvCPSFlag] of DWORD =
    (CREATE_DEFAULT_ERROR_MODE, CREATE_NEW_CONSOLE, CREATE_NEW_PROCESS_GROUP,
     CREATE_SEPARATE_WOW_VDM, CREATE_SHARED_WOW_VDM, CREATE_SUSPENDED,
     CREATE_UNICODE_ENVIRONMENT, DETACHED_PROCESS);
var
  LConsoleHandles: TJvRWEHandles; // Handles which the console will use
  LLocalHandles: TJvRWHandles; // Handles which we will use
  LStartupInfo: TStartupInfo;
  Flags: DWORD;
  F: TJvCPSFlag;
  AppName, CurrDir: PChar;
  EnvironmentData: PChar;
  DoRedirect: Boolean;
begin
  CheckNotWaiting;
  FState := psReady;
  FStartsOnNewLine := True;
  FCurrentLine := '';
  FCursorPosition := 0;
  DoRedirect := coRedirect in ConsoleOptions;

  FillChar(FProcessInfo, SizeOf(FProcessInfo), #0);
  FillChar(LLocalHandles, SizeOf(LLocalHandles), #0);
  FillChar(LConsoleHandles, SizeOf(LConsoleHandles), #0);

  Flags := ProcessPriorities[FPriority];
  for F := Low(TJvCPSFlag) to High(TJvCPSFlag) do
    if F in FCreationFlags then
      Inc(Flags, CreationFlagsValues[F]);
  AppName := Pointer(Trim(FApplicationName));
  CurrDir := Pointer(Trim(FCurrentDirectory));
  if Environment.Count = 0 then
    EnvironmentData := nil
  else
    StringsToMultiSz(EnvironmentData, Environment);

  try
    LStartupInfo := FStartupInfo.GetStartupInfo;

    if DoRedirect then
    begin
      if not ConstructPipe(LConsoleHandles, LLocalHandles) then
        RaiseLastOSError;

      with LStartupInfo do
      begin
        dwFlags := dwFlags or STARTF_USESTDHANDLES;
        hStdOutput := LConsoleHandles.Write;
        hStdInput := LConsoleHandles.Read;
        hStdError := LConsoleHandles.Error;
      end;
    end;

    if not CreateProcess(AppName, PChar(FCommandLine), nil, nil, DoRedirect,
      Flags, EnvironmentData, CurrDir, LStartupInfo, FProcessInfo) then
    begin
      CloseProcessHandles;
      SafeCloseHandle(LLocalHandles.Write);
      SafeCloseHandle(LLocalHandles.Read);
      RaiseLastOSError;
    end;

    if DoRedirect then
    begin
      { (rb) We assume that a thread is done if its pointer (FReadThread/FWaitThread)
             is nil (See code of ReadThreadTerminated and WaitThreadTerminated).
             Thus we have to create both threads before we start any of them
             (otherwise it will go wrong with very fast finishing executables)
             (See Mantis #1393)
      }
      FState := psWaiting;

      FReadThread := TJvReadThread.Create(LLocalHandles.Read, Handle);
      FReadThread.OnTerminate := ReadThreadTerminated;

      FWaitThread := TJvConsoleThread.Create(FProcessInfo.hProcess, LLocalHandles.Write);
      FWaitThread.OnTerminate := ConsoleWaitThreadTerminated;

      FReadThread.Resume;
      FWaitThread.Resume;
    end
    else
    if FWaitForTerminate then
    begin
      FState := psWaiting;

      FWaitThread := TJvWaitForProcessThread.Create(FProcessInfo.hProcess);
      FWaitThread.OnTerminate := WaitThreadTerminated;
      FWaitThread.Resume;
    end
    else
    begin
      { http://support.microsoft.com/default.aspx?scid=kb;en-us;124121 }
      WaitForInputIdle(FProcessInfo.hProcess, INFINITE);
      CloseProcessHandles;
      FState := psRunning;
    end;
  finally
    { Close pipe handles (do not continue to modify the parent).
      You need to make sure that no handles to the write end of the
      output pipe are maintained in this process or else the pipe will
      not close when the child process exits and the ReadFile will hang.
    }
    SafeCloseHandle(LConsoleHandles.Write);
    SafeCloseHandle(LConsoleHandles.Read);
    SafeCloseHandle(LConsoleHandles.Error);
    FreeMultiSz(EnvironmentData);
  end;
end;

procedure TJvCreateProcess.SetEnvironment(const Value: TStrings);
begin
  FEnvironment.Assign(Value);
end;

procedure TJvCreateProcess.SetWaitForTerminate(const Value: Boolean);
begin
  CheckNotWaiting;
  FWaitForTerminate := Value;
  FState := psReady;
end;

procedure TJvCreateProcess.StartConsoleEnding;
begin
  if not Assigned(FEndLock) then
    FEndLock := TCriticalSection.Create;
  FEndLock.Enter;
end;

procedure TJvCreateProcess.StopWaiting;
begin
  TerminateWaitThread;
end;

procedure TJvCreateProcess.Terminate;
begin
  CheckRunning;
  InternalTerminateProcess(FProcessInfo.dwProcessId);
end;

procedure TJvCreateProcess.TerminateWaitThread;
begin
  { This is a dangerous function; because the read thread uses a blocking
    function there's no way we can stop it (normally); just signal the
    thread that is has to end;

    Note that thus it's the user responsibility to ensure that the console
    will end. If the console ends, the read thread will end also.

    An console can (always?) be ended by calling 'TJvCreateProcess.Terminate'
  }
  if FState = psWaiting then
  begin
    if Assigned(FWaitThread) then
    begin
      FWaitThread.OnTerminate := nil;
      TJvWaitForProcessThread(FWaitThread).TerminateThread;
      FWaitThread := nil;
    end;
    if Assigned(FReadThread) then
    begin
      FReadThread.OnTerminate := nil;
      TJvReadThread(FReadThread).TerminateThread;
      FReadThread := nil;
    end;
    FState := psReady;
    CloseProcessHandles;
  end;
end;

procedure TJvCreateProcess.WaitThreadTerminated(Sender: TObject);
begin
  FWaitThread := nil;

  { We only fire a TerminateEvent if both the read thread and the wait thread
    have terminated; usually the read thread will terminate before the wait
    thread: }

  FExitCode := TJvWaitForProcessThread(Sender).FExitCode;
  DoTerminateEvent;
end;

procedure TJvCreateProcess.WndProc(var Msg: TMessage);
begin
  with Msg do
    if Msg = CM_READ then
    try
      HandleReadEvent;
    except 
      if Assigned(ApplicationHandleException) then
        ApplicationHandleException(Self); 
    end
    else
      Result := DefWindowProc(Handle, Msg, WParam, LParam);
end;

function TJvCreateProcess.Write(const S: string): Boolean;
begin
  Result := (FWaitThread is TJvConsoleThread) and
    TJvConsoleThread(FWaitThread).Write(S);
end;

function TJvCreateProcess.WriteLn(const S: string): Boolean;
begin
  Result := Write(S + sLineBreak);
end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQCreateProcess.pas,v $';
    Revision: '$Revision: 1.15 $';
    Date: '$Date: 2004/11/06 22:08:16 $';
    LogPath: 'JVCL\run'
  );

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.