teedoscommand.pas

BCB第三方组件

  end;

  if not (CreatePipe(read_stdout, newstdout, sa, 0)) then //create stdout pipe
  begin
    raise FCreateProcessError;
    CloseHandle(newstdin);
    CloseHandle(write_stdin);
    Exit;
  end;

  GetStartupInfo(si); //set startupinfo for the spawned process
 {The dwFlags member tells CreateProcess how to make the process.
 STARTF_USESTDHANDLES validates the hStd* members. STARTF_USESHOWWINDOW
 validates the wShowWindow member.}

  si.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
  si.wShowWindow := SW_HIDE;
  si.hStdOutput := newstdout;
  si.hStdError := newstdout; //set the new handles for the child process
  si.hStdInput := newstdin;
  app_spawn := PChar(FCommandLine);

 //spawn the child process
  if not (CreateProcess(nil, app_spawn, nil, nil, TRUE,
    CREATE_NEW_CONSOLE or FPriority, nil, nil, si, pi)) then
  begin
    FTimer.Ending; //turn the timer off
    Terminated:=True;
    CloseHandle(newstdin);
    CloseHandle(newstdout);
    CloseHandle(read_stdout);
    CloseHandle(write_stdin);
    FCreateProcessError := TCreateProcessError.Create('Error creating process: '+String(app_spawn)
      + ' ' + SysErrorMessage(GetLastError));
    raise FCreateProcessError;
  end;

  Last := ''; // Buffer to save last output without finished with CRLF
  LineBeginned := False;
  iBufSize := MaxBufSize;
  pBuf := AllocMem(iBufSize); // Reserve and init Buffer
  try
    repeat //main program loop
      GetExitCodeProcess(pi.hProcess, Exit_Code); //while the process is running
      DosExitCode:=Exit_Code;
      PeekNamedPipe(read_stdout, pBuf, iBufSize, @bread, @avail, nil);

      //check to see if there is any data to read from stdout
      if (bread <> 0) then begin
        if (iBufSize < avail) then begin // If BufferSize too small then rezize
          iBufSize := avail;
          ReallocMem(pBuf, iBufSize);
        end;

        FillChar(pBuf^, iBufSize, #0); //empty the buffer
        ReadFile(read_stdout, pBuf^, iBufSize, bread, nil); //read the stdout pipe
        Str := Last; //take the begin of the line (if exists)

        i := 0;
        while ((i < bread) and not (Terminated)) do begin
          case pBuf^[i] of
            #0: Inc(i);
            #10:
              begin
                Inc(i);
                FTimer.NewOutput; //a new ouput has been caught
                FLines.add(Str); //add the line
                if (FOutputLines <> nil) then
                  if LineBeginned then begin
                    FOutputLines[FOutputLines.Count - 1] := Str;
                    LineBeginned := False;
                  end
                  else
                    FOutputLines.Add(Str);
                if Assigned(FOnNewLine) then
                  FOnNewLine(FOwner, Str, otEntireLine);
                Str := '';
              end;
            #13: begin
                Inc(i);
                if (i < bread) and (pBuf^[i] = #10) then
                  Inc(i); //so we don't test the #10 on the next step of the loop
                FTimer.NewOutput; //a new ouput has been caught
                FLines.add(Str); //add the line
                if (FOutputLines <> nil) then
                  if LineBeginned then begin
                    FOutputLines[FOutputLines.Count - 1] := Str;
                    LineBeginned := False;
                  end
                  else
                    FOutputLines.Add(Str);
                if Assigned(FOnNewLine) then
                  FOnNewLine(FOwner, Str, otEntireLine);
                Str := '';
              end;
          else begin
              Str := Str + pBuf^[i]; //add a character
              Inc(i);
            end;
          end;
        end;
        Last := Str; // no CRLF found in the rest, maybe in the next output
        if (Last <> '') then
        begin
          if (FOutputLines <> nil) then
            if LineBeginned then
              FOutputLines[FOutputLines.Count - 1] := Last
            else
              FOutputLines.Add(Last);
          if Assigned(FOnNewLine) then
            FOnNewLine(FOwner, Str, otBeginningOfLine);
          LineBeginned := True;
        end;
      end
      else
      //send lines in input (if exist)
        while ((InputLines.Count > 0) and not (Terminated)) do
        begin
          FillChar(pBuf^, iBufSize, #0); //clear the buffer
          for II := 2 to Length(InputLines[0]) do //copy the string in the buffer
            pBuf^[II - 2] := InputLines[0][II];
          if (InputLines[0][1] = '_') then
          begin
            pBuf^[Length(InputLines[0]) - 1] := #13; //add CR/LF at the end of line
            pBuf^[Length(InputLines[0])] := #10;
            II := Length(Inputlines[0]) + 1;
          end
          else II := Length(Inputlines[0]) - 1;
          WriteFile(write_stdin, pBuf^, II, bread, nil); //send it to stdin
          if FInputToOutput then //if we have to output the inputs
          begin
            InputLines[0] := Copy(InputLines[0], 2, Length(InputLines[0]) - 1);
            //the first char has to be ignored
            if (FOutputLines <> nil) then
              if LineBeginned then begin //if we are continuing a line
                Last := Last + InputLines[0];
                FOutputLines[FOutputLines.Count - 1] := Last;
                LineBeginned := False;
              end
              else //if it's a new line
                FOutputLines.Add(InputLines[0]);
            if Assigned(FOnNewLine) then
              FOnNewLine(FOwner, Last, otEntireLine);
            Last := '';
          end;
            InputLines.Delete(0); //delete the line that has been send
        end;

      Sleep(1); // Give other processes a chance

      if Terminated then //the user has decided to stop the process
        TerminateProcess(pi.hProcess, 0);

    until ((Exit_Code <> STILL_ACTIVE) //process terminated (normally)
      or ((FMaxTimeAfterBeginning < FTimer.FSinceBeginning)
      and (FMaxTimeAfterBeginning > 0)) //time out
      or ((FMaxTimeAfterLastOutput < FTimer.FSinceLastOutput)
      and (FMaxTimeAfterLastOutput > 0))); //time out

    if (Last <> '') then begin // If not empty flush last output
      FLines.Add(Last);
      if FOutputLines <> nil then
        if LineBeginned then
          FOutputLines[FOutputLines.Count - 1] := Last
        else
          FOutputLines.Add(Last);
      if Assigned(FOnNewLine) then
        FOnNewLine(FOwner, Last, otEntireLine);
    end;
  finally
    FreeMem(pBuf);
  end;

  FreeMem(sd);
  FreeMem(sa);

  CloseHandle(pi.hThread);
  CloseHandle(pi.hProcess);
  CloseHandle(newstdin); //clean stuff up
  CloseHandle(newstdout);
  CloseHandle(read_stdout);
  CloseHandle(write_stdin);
  FTimer.Ending; //turn the timer off
  Terminated:=True;

  if Assigned(FOnTerminated) then
    FOnTerminated(FOwner);
end;

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

procedure TDosThread.Execute;
begin
  FExecute;
end;

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

constructor TDosThread.Create(AOwner: TObject; Cl: string; L: TStringList;
  Ol: TStrings; t: TProcessTimer; mtab, mtalo: Integer; Onl: TNewLineEvent;
  Ot: TNotifyEvent; p: Integer; ito: Boolean);
begin
  FOwner := AOwner;
  FCommandline := Cl;
  FLines := L;
  FOutputLines := Ol;
  InputLines := TStringList.Create;
  InputLines.Clear;
  FInputToOutput := ito;
  FOnNewLine := Onl;
  FOnTerminated := Ot;
  FTimer := t;
  FMaxTimeAfterBeginning := mtab;
  FMaxTimeAfterLastOutput := mtalo;
  FPriority := p;
  inherited Create(False);
end;

Destructor TDosThread.Destroy;
begin
  FreeAndNil(InputLines);
  inherited;
end;

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

constructor TDosCommand.Create(AOwner: TComponent);
begin
  inherited;
  FOwner := AOwner;
  FCommandLine := '';
  FLines := TStringList.Create;
  Flines.Clear;
  FTimer := nil;
  FMaxTimeAfterBeginning := 0;
  FMaxTimeAfterLastOutput := 0;
  FPriority := NORMAL_PRIORITY_CLASS;
end;

Destructor TDosCommand.Destroy;
begin
  FreeAndNil(FLines);
  FreeAndNil(FThread);
  FreeAndNil(FTimer);
  inherited;
end;

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

procedure TDosCommand.SetOutputLines(Value: TStrings);
begin
  if (FOutputLines <> Value) then
    FOutputLines := Value;
end;

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

procedure TDosCommand.Execute;
begin
  if (FCommandLine <> '') then
  begin
    if (FTimer = nil) then //create the timer (first call to execute)
      FTimer := TProcessTimer.Create(FOwner);
    FLines.Clear; //clear old outputs
    FTimer.Beginning; //turn the timer on
    FThread := TDosThread.Create(Self, FCommandLine, FLines, FOutputLines,
      FTimer, FMaxTimeAfterBeginning, FMaxTimeAfterLastOutput, FOnNewLine,
      FOnTerminated, FPriority, FInputToOutput);

    if not Assigned(FThread) then
       raise Exception.Create('DOS Thread cannot be created when executing: '+#13+FCommandLine);
  end;
end;

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

procedure TDosCommand.Stop;
begin
  if (FThread <> nil) then
  begin
    FThread.DoTerminate; //terminate the process
    FThread.Free; //free memory
    FThread := nil;
  end;
end;

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

procedure TDosCommand.SendLine(Value: string; Eol: Boolean);
const
  EolCh: array[Boolean] of Char = (' ', '_');
begin
  if (FThread <> nil) then
    FThread.InputLines.Add(EolCh[Eol] + Value);
end;

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

{
procedure Register;
begin
  RegisterComponents('Samples', [TDosCommand]);
end;
}

//------------------------------------------------------------------------------
function TDosCommand.Terminated: Boolean;
begin
 result:=FThread.Terminated;
end;

function TDosCommand.DosExitCode: Integer;
begin
  result:=FThread.DosExitCode;
end;

end.