jvqcreateprocess.pas

East make Tray Icon in delphi

  else
  begin
    ProcessHandle := OpenProcess(PROCESS_ALL_ACCESS, False, ProcessID);
    OSCheck(ProcessHandle <> 0);
    try
      PriorityClass := GetPriorityClass(ProcessHandle);
      OSCheck(PriorityClass <> 0);
      case PriorityClass of
        NORMAL_PRIORITY_CLASS:
          Result := ppNormal;
        IDLE_PRIORITY_CLASS:
          Result := ppIdle;
        HIGH_PRIORITY_CLASS:
          Result := ppHigh;
        REALTIME_PRIORITY_CLASS:
          Result := ppRealTime;
      else
        Result := ppNormal;
      end;
    finally
      CloseHandle(ProcessHandle);
    end;
  end;
end;

function TJvProcessEntry.GetSystemIconIndex(IconType: Integer): Integer;
var
  FileInfo: TSHFileInfo;
begin
  FillChar(FileInfo, SizeOf(FileInfo), #0);
  SHGetFileInfo(PChar(FileName), 0, FileInfo, SizeOf(FileInfo),
    SHGFI_SYSICONINDEX or IconType);
  Result := FileInfo.iIcon;
end;

class function TJvProcessEntry.PriorityText(Priority: TJvProcessPriority): string;
begin
  case Priority of
    ppIdle:
      Result := RsIdle;
    ppNormal:
      Result := RsNormal;
    ppHigh:
      Result := RsHigh;
    ppRealTime:
      Result := RsRealTime;
  end;
end;

procedure TJvProcessEntry.SetPriority(const Value: TJvProcessPriority);
var
  ProcessHandle: THandle;
begin
  ProcessHandle := OpenProcess(PROCESS_SET_INFORMATION, False, ProcessID);
  OSCheck(ProcessHandle <> 0);
  try
    OSCheck(SetPriorityClass(ProcessHandle, ProcessPriorities[Value]));
  finally
    CloseHandle(ProcessHandle);
  end;
end;

function TJvProcessEntry.Terminate: Boolean;
begin
  Result := InternalTerminateProcess(FProcessID);
end;

//=== { TJvCPSStartupInfo } ==================================================

constructor TJvCPSStartupInfo.Create;
begin
  inherited Create;
  FDefaultSize := True;
  FDefaultPosition := True;
  FDefaultWindowState := True;
  FShowWindow := swNormal;
end;

procedure TJvCPSStartupInfo.AssignTo(Dest: TPersistent);
begin
  if Dest is TJvCPSStartupInfo then
    with TJvCPSStartupInfo(Dest) do
    begin
      FDesktop := Self.FDesktop;
      FTitle := Self.FTitle;
      FLeft := Self.FLeft;
      FTop := Self.FTop;
      FDefaultPosition := Self.FDefaultPosition;
      FWidth := Self.FWidth;
      FHeight := Self.FHeight;
      FDefaultSize := Self.FDefaultSize;
      FShowWindow := Self.FShowWindow;
      FDefaultWindowState := Self.FDefaultWindowState;
      FForceOnFeedback := Self.FForceOnFeedback;
      FForceOffFeedback := Self.FForceOffFeedback;
    end
  else
    inherited AssignTo(Dest);
end;

function TJvCPSStartupInfo.GetStartupInfo: TStartupInfo;
const
  ShowWindowValues: array [TJvCPSShowWindow] of DWORD =
    (SW_HIDE, SW_SHOWMINIMIZED, SW_SHOWMAXIMIZED, SW_SHOWNORMAL);
begin
  FillChar(Result, SizeOf(TStartupInfo), #0);
  with Result do
  begin
    cb := SizeOf(TStartupInfo);
    if Length(FDesktop) > 0 then
      lpDesktop := PChar(FDesktop);
    if Length(FTitle) > 0 then
      lpTitle := PChar(Title);
    if not FDefaultPosition then
    begin
      dwX := FLeft;
      dwY := FTop;
      Inc(dwFlags, STARTF_USEPOSITION);
    end;
    if not FDefaultSize then
    begin
      dwXSize := FWidth;
      dwYSize := FHeight;
      Inc(dwFlags, STARTF_USESIZE);
    end;
    if not FDefaultWindowState then
    begin
      wShowWindow := ShowWindowValues[FShowWindow];
      Inc(dwFlags, STARTF_USESHOWWINDOW);
    end;
    if FForceOnFeedback then
      Inc(dwFlags, STARTF_FORCEONFEEDBACK);
    if FForceOffFeedback then
      Inc(dwFlags, STARTF_FORCEOFFFEEDBACK);
  end;
end;

//=== { TJvWaitForProcessThread } ============================================

constructor TJvWaitForProcessThread.Create(ProcessHandle: DWORD);
begin
  inherited Create(True);
  FreeOnTerminate := True;
  Priority := tpLower;
  FCloseEvent := CreateEvent(nil, True, False, nil);
  FProcessHandle := ProcessHandle;
end;

destructor TJvWaitForProcessThread.Destroy;
begin
  SafeCloseHandle(FCloseEvent);
  inherited Destroy;
end;

procedure TJvWaitForProcessThread.Execute;
var
  WaitHandles: array [0..1] of THandle;
begin
  WaitHandles[0] := FCloseEvent;
  WaitHandles[1] := FProcessHandle;
  WaitForInputIdle(FProcessHandle, INFINITE);
  case WaitForMultipleObjects(2, PWOHandleArray(@WaitHandles[0]), False, INFINITE) of
    WAIT_OBJECT_0:
      FExitCode := MAXDWORD;
    WAIT_OBJECT_0 + 1:
      GetExitCodeProcess(FProcessHandle, FExitCode);
  else
    RaiseLastOSError;
  end;
end;

procedure TJvWaitForProcessThread.TerminateThread;
begin
  Terminate;
  SetEvent(FCloseEvent);
end;

//=== { TJvReadThread } ======================================================

constructor TJvReadThread.Create(AReadHandle, ADestHandle: THandle);
begin
  inherited Create(True);

  FreeOnTerminate := True;
  Priority := tpLower;

  FReadLock := TCriticalSection.Create;

  // Note: TJvReadThread is responsible for closing the FReadHandle
  FReadHandle := AReadHandle;
  FDestHandle := ADestHandle;

  FInputBuffer := nil;
  FInputBufferSize := CCPS_BufferSize;
  FInputBufferEnd := 0;
  ReallocMem(FInputBuffer, FInputBufferSize);
  GetMem(FPreBuffer, CCPS_BufferSize);
end;

destructor TJvReadThread.Destroy;
begin
  SafeCloseHandle(FReadHandle);
  inherited Destroy;
  { It is (theoretically) possible that the inherited Destroy triggers an
    OnTerminate event and the following fields can be accessed in the handler,
    thus free them after the destroy.
  }
  ReallocMem(FInputBuffer, 0);
  FReadLock.Free;
  FreeMem(FPreBuffer);
end;

procedure TJvReadThread.CloseRead;
begin
  FReadLock.Acquire;
  try
    SafeCloseHandle(FReadHandle);
  finally
    FReadLock.Release;
  end;
end;

procedure TJvReadThread.CopyToBuffer(Buffer: PChar; ASize: Cardinal);
// Copy data in Buffer (with size ASize) to FInputBuffer.
begin
  FReadLock.Acquire;
  try
    if FInputBufferEnd + ASize > FInputBufferSize then
    begin
      // Safety check..
      if FInputBufferSize > CCPS_MaxBufferSize then
        // ..main thread seems to be blocked; flush the input buffer
        FInputBufferEnd := 0
      else
      begin
        // Need to upscale FInputBuffer
        FInputBufferSize := FInputBufferSize * 2;
        ReallocMem(FInputBuffer, FInputBufferSize);
      end;
    end;

    // Do the copy
    Move(Buffer[0], FInputBuffer[FInputBufferEnd], ASize);
    Inc(FInputBufferEnd, ASize);
  finally
    FReadLock.Release;
  end;

  // Notify TJvCreateProcess that data has been read from the pipe
  PostMessage(FDestHandle, CM_READ, 0, 0);
end;

procedure TJvReadThread.Execute;
// Read data from the pipe (FReadHandle) to FPreBuffer
var
  BytesRead: Cardinal;
begin
  { FTerminateAfterLoopEntered and FLoopEntered ensure that the loop is
    entered minimal once, ie ReadFile is called minimal once. This ensures that
    the output of very fast finishing executables is read. (We can't change
    the loop to repeat until and call Terminate because Terminated is checked
    in Classes.ThreadProc just before Execute is entered.)
  }

  while not Terminated or (FTerminateAfterLoopEntered and FLoopEntered) do
  begin
    FLoopEntered := True;

    { ReadFile will block until *some* data is available on the pipe }
    if not ReadFile(FReadHandle, FPreBuffer[0], CCPS_BufferSize, BytesRead, nil) then
    begin
      // Only exit if last error is ERROR_BROKEN_PIPE, thus ignore other errors
      if GetLastError = ERROR_BROKEN_PIPE then
        // pipe done - normal exit path.
        Exit;
    end
    else
      CopyToBuffer(FPreBuffer, BytesRead);
  end;
end;

function TJvReadThread.ReadBuffer(var ABuffer: TJvCPSBuffer;
  out ABufferSize: Cardinal): Boolean;
// Copy FInputBuffer to ABuffer.
// This function is executed in the context of the main thread;
// FReadLock is for synchronization with the read thread.
begin
  FReadLock.Acquire;
  try
    Result := FInputBufferEnd > 0;
    if not Result then
      Exit;

    ABufferSize := Min(FInputBufferEnd, CCPS_BufferSize);

    // Copy the data from FInputBuffer to ABuffer.
    Move(FInputBuffer[0], ABuffer[0], ABufferSize);

    // If not all data in FInputBuffer is copied to ABuffer, then place
    // the data not copied at the begin of FInputBuffer.
    if FInputBufferEnd > ABufferSize then
      Move(FInputBuffer[ABufferSize], FInputBuffer[0],
        FInputBufferEnd - ABufferSize);

    Dec(FInputBufferEnd, ABufferSize);
  finally
    FReadLock.Release;
  end;
end;

procedure TJvReadThread.TerminateThread;
begin
  if FLoopEntered then
  begin
    Terminate;
    CloseRead;
  end
  else
    FTerminateAfterLoopEntered := True;
end;

//=== { TJvConsoleThread } ===================================================

constructor TJvConsoleThread.Create(ProcessHandle: DWORD;
  AWriteHandle: THandle);
begin
  inherited Create(ProcessHandle);

  FWriteLock := TCriticalSection.Create;

  // Note: TJvConsoleThread is responsible for closing the FWriteHandle
  FWriteHandle := AWriteHandle;

  FWriteEvent := CreateEvent(
    nil, // No security attributes
    True, // Manual reset
    False, // Initial state
    nil // No name
    );
end;

destructor TJvConsoleThread.Destroy;
begin
  SafeCloseHandle(FWriteHandle);
  SafeCloseHandle(FWriteEvent);
  inherited Destroy;
  { It is (theoretically) possible that the inherited Destroy triggers an
    OnTerminate event and the following fields can be accessed in the handler,
    thus free them after the destroy.
  }
  FWriteLock.Free;
end;

procedure TJvConsoleThread.CloseWrite;
begin
  FWriteLock.Acquire;
  try
    SafeCloseHandle(FWriteHandle);
  finally
    FWriteLock.Release;
  end;
end;

procedure TJvConsoleThread.Execute;
var
  WaitHandles: array [0..2] of THandle;
  HandleCount: Cardinal;
begin
  WaitHandles[0] := FCloseEvent;
  WaitHandles[1] := FProcessHandle;
  WaitHandles[2] := FWriteEvent;
  HandleCount := 3;

  WaitForInputIdle(FProcessHandle, INFINITE);

  while not Terminated do
    case WaitForMultipleObjects(HandleCount, PWOHandleArray(@WaitHandles[0]), False, INFINITE) of
      WAIT_OBJECT_0:
        begin
          // Close event fired; exit
          FExitCode := MAXDWORD;
          Exit;
        end;
      WAIT_OBJECT_0 + 1:
        begin
          // process ended; exit
          GetExitCodeProcess(FProcessHandle, FExitCode);
          Exit;
        end;
      WAIT_OBJECT_0 + 2:
        // Write event fired; try to write
        if not TryWrite then
          // No longer respond when write event fires
          HandleCount := 2;
    else
      Exit;
    end;
end;

function TJvConsoleThread.TryWrite: Boolean;
// Write data in FOutputBuffer to the pipe (FWriteHandle)
// Result = False; if console or user has closed the pipe.
var
  BytesWritten: Cardinal;
  BytesToWrite: Cardinal;
begin
  Result := True;

  FWriteLock.Acquire;
  try
    try
      { Check handle inside lock, because it can be closed by another thread, by
        calling CloseWrite }
      if FWriteHandle = 0 then
        Exit;

      if FOutputBufferEnd <= 0 then
        Exit;

      BytesToWrite := FOutputBufferEnd;

      if not WriteFile(FWriteHandle, FOutputBuffer, BytesToWrite, BytesWritten, nil) then
      begin
        { WriteFile documentation on MSDN states that WriteFile returns
          ERROR_BROKEN_PIPE if the console closes it's read handle, but that
          seems incorrect; check it anyway }
        if (GetLastError = ERROR_NO_DATA) or (GetLastError = ERROR_BROKEN_PIPE) then
          // Pipe was closed (normal exit path).
          SafeCloseHandle(FWriteHandle);
        Exit;
      end;

      if BytesWritten <= 0 then
        Exit;

      if BytesWritten < BytesToWrite then
        // Move unwritten tail to the begin of the buffer
        Move(FOutputBuffer[BytesWritten], FOutputBuffer[0], BytesToWrite - BytesWritten);

      Dec(FOutputBufferEnd, BytesWritten);
    finally
      Result := FWriteHandle <> 0;
      if FOutputBufferEnd = 0 then
        ResetEvent(FWriteEvent);
    end;
  finally
    FWriteLock.Release;
  end;
end;

function TJvConsoleThread.Write(const S: string): Boolean;
// Add S to FOutputBuffer; actual writing is done in TryWrite.
// This function is executed in the context of the main thread;
// FWriteLock is for synchronization with the write thread.
begin
  if Length(S) <= 0 then
  begin
    Result := True;
    Exit;
  end;

  FWriteLock.Acquire;
  try
    Result := FWriteHandle <> 0;
    if not Result then
      Exit;

    Result := Cardinal(Length(S)) + FOutputBufferEnd <= CCPS_BufferSize;
    if not Result then
      Exit;

    Move(PChar(S)^, FOutputBuffer[FOutputBufferEnd], Length(S));
    Inc(FOutputBufferEnd, Length(S));

    if FOutputBufferEnd > 0 then
      // Notify the TJvConsoleThread that there is some data to write
      SetEvent(FWriteEvent);
  finally
    FWriteLock.Release;
  end;
end;

//=== { TJvCreateProcess } ===================================================

constructor TJvCreateProcess.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCreationFlags := [];
  FEnvironment := TStringList.Create;
  FPriority := ppNormal;
  FState := psReady;
  FWaitForTerminate := True;
  FStartupInfo := TJvCPSStartupInfo.Create;
  FConsoleOutput := TStringList.Create;
  FConsoleOptions := [coOwnerData];
end;