freepascal.compiler/fcl/win32/process.inc

uses windows;

Function TProcess.GetRunning : Boolean;

begin
  IF FRunning then
    Frunning:=GetExitStatus=Still_Active;
  Result:=FRunning;
end;

Procedure TProcess.Execute;

Var PName,PDir : PChar;
    FStartupInfo : TStartupInfo;
    FProcessAttributes,
    FTHreadAttributes : TSecurityAttributes;    
    FProcessInformation : TProcessInformation;
    status : longbool;
    
begin
  FillChar(FProcessAttributes,SizeOf(FProcessAttributes),#0);
  FillChar(FThreadAttributes,SizeOf(FThreadAttributes),#0);
  FillChar(FStartupInfo,SizeOf(FStartupInfo),#0);
  if poNoConsole in FCReateOptions then
    FCreationFlags:=FCreationFlags or Detached_Process;
  If poRunSuspended in FCreateOptions Then
    FCreationFlags:=FCreationFlags or Create_Suspended;
  If poUsePipes in FCreateOptions then
    begin
    FreeStreams;
    CreatePipeStreams (FChildInputSTream,FParentOutPutStream);
    CreatePipeStreams (FParentInputStream,FChildOutPutStream);
    if poStdErrToOutPut in FCreateOptions then
      CreatePipeStreams (FParentErrorStream,FChildErrorStream)
    else
      begin
      FChildErrorStream:=FChildOutPutStream;
      FParentErrorStream:=FParentInputStream;
      end;
    end;
  With FStartupInfo do
    begin
    if poUsePipes in FCreateOptions then
      begin
      dwFlags:=dwFlags or Startf_UseStdHandles;
      hStdInput:=FChildInputStream.Handle;
      hStdOutput:=FChildOutPutStream.Handle;
      hStdError:=FChildErrorStream.Handle;
      end;
    If (FFillAttribute<>-1) then
      begin
      dwFlags:=dwFlags or Startf_UseFillAttribute;
      dwFillAttribute:=FFIllAttribute;
      end;
    If FShowWindow then
      begin
      dwFlags:=dwFlags or Startf_UseShowWindow;
      // ?? dwXCountChars:=Value;
      end;
    if FWindowWidth<>-1 then
      begin
      dwFlags:=dwFlags or Startf_UseCountChars;
      dwXCountChars:=FWindowWidth;
      end;
    if FWindowRows<>-1 then
      begin
      dwFlags:=dwFlags or Startf_UseCountChars;
      dwYCountChars:=FWindowRows;
      end;
    if FWindowHeight<>-1 then
      begin
      dwFlags:=dwFlags or Startf_UsePosition;
      dwYsize:=FWindowHeight;
      end;
    If FWindowWidth<>-1 then
      begin
      dwFlags:=dwFlags or Startf_UsePosition;
      dwxsize:=FWindowWidth;
      end;
    IF FWindowLeft<>-1 then
      begin
      dwFlags:=dwFlags or Startf_UseSize;
      dwx:=FWindowLeft;
      end;
    If FWindowTop<>-1 then
      begin
      dwFlags:=dwFlags or Startf_UseSize;
      dwy:=FWindowTop;
      end;
    end;
  Writeln ('About to start');  
  If FApplicationName<>'' then PName:=Pchar(FApplicationName) else PName:=Nil;
  If FCurrentDirectory<>'' then PName:=Pchar(FCurrentDirectory) else PDir:=Nil;
  Status:=CreateProcess (Pname,PChar(FCommandLine),@FProcessAttributes,@FThreadAttributes,
                 FInheritHandles,FCreationFlags,FEnvironment,PDir,@FStartupInfo,
                 @fProcessInformation);
  Writeln ('Created ',Status);               
  FTHreadHandle:=fProcessInformation.hthread;
  Writeln ('ThreadHandle :',FThreadHandle);
  FHandle:=fProcessInformation.hProcess;
  Writeln ('Process Handle :',FHandle);
  FPID:=fProcessInformation.dwProcessID;
  Writeln ('Process Handle :',FPID);
  FRunning:=True;
  if (poWaitOnExit in FCreateOptions) and
      not (poRunSuspended in FCreateOptions) then
    WaitOnExit;
end;

Function TProcess.WaitOnExit : Dword;

begin
  Result:=WaitForSingleObject (FHandle,Infinite);
  If Result<>Wait_Failed then
    GetExitStatus;
  FRunning:=False;
end;

Function TProcess.Suspend : Longint;

begin
  Result:=SuspendThread(ThreadHandle);
end;

Function TProcess.Resume : LongInt;

begin
  Result:=ResumeThread(ThreadHandle);
end;

Function TProcess.Terminate(AExitCode : Integer) : Boolean;

begin
  Result:=False;
  If ExitStatus=Still_active then
    Result:=TerminateProcess(Handle,AexitCode);
end;
{
  $Log$
  Revision 1.3  2000-07-25 11:27:35  jonas
    * fixed missing comment openers for log section

  Revision 1.2  2000/07/13 11:33:07  michael
  + removed logs
 
}