DOS-Programm ausführen

[rowkajjh]

Hallo,

mit CreateProcess kann man ja ein dos-Programm starten. Kann man irgendwie das aufpoppen des DOS-Fensters unterdrücken und die Ausgabe des Programmes (also was es auf die Konsole schreiben würde) bekommen?

Danke für jede Hilfe!

Tschau.

[dfried]

Kuck dir mal TDosCommand an. Das ist wahrscheinlich das was du suchst.

[rowkajjh]

Habe ich angeschaut, danke! Das erwies sich aber als besser (Vorsicht, lang!):

Delphi-Quellcode:

(*===========================================================================*
 | StdIORedirect
 |
 |
 |
 | Component to get output from and provide input to command line apps
 |
 |
 |
 | Copyright (C) Colin Wilson 1999.  All rights reserved
 |
 |
 |
 | Public methods and properties:
 |
 |
 |
 | procedure Run (fileName, cmdLine, directory : string);
 |
 |   Run a program with redirected output
 |
 | procedure AddInputText (const st : string);
 |
 |   Add a line of text to be sent to the application's STDIN
 |
 | procedure Terminate;
 |
 |   Terminate the program started with 'Run'
 |
 | property ReturnValue : DWORD read fReturnValue;
    property OutputText : TStrings read fOutputText;
    property ErrorText : TStrings read fErrorText;
    property Running : boolean read fRunning;


  published
    property OnOutputText : TOnText read fOnOutputText write fOnOutputText;
    property OnErrorText : TOnText read fOnErrorText write fOnErrorText;
    property OnTerminate : TNotifyEvent read fOnTerminate write 
fOnTerminate;
  
*===========================================================================
*)
unit uStdIORedirect;
{$WARN SYMBOL_DEPRECATED OFF}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
SyncObjs;

type
  TOnText = procedure (sender : TObject; st : string) of object;
  TStdIORedirect = class(TComponent)
  private
    fErrorRead: THandle;
    fOutputRead: THandle;
    fInputWrite: THandle;

    fErrorWrite : THandle;
    fOutputWrite : THandle;
    fInputRead : THandle;
    fProcessInfo : TProcessInformation;
    fReturnValue: DWORD;

    fOutputLineBuff : string;
    fErrorLineBuff : string;

    fErrorText: TStrings;
    fOutputText: TStrings;
    fInputText : TStrings;

    fOutputStream : TStream;
    fErrorStream : TStream;

    fOutputStreamPos : Integer;
    fErrorStreamPos : Integer;

    fOnErrorText: TOnText;
    fOnOutputText: TOnText;

    fInputEvent : TEvent;
    fRunning: boolean;
    fOnTerminate: TNotifyEvent;

    procedure CreateHandles;
    procedure DestroyHandles;
    procedure HandleOutput;
    { Private declarations }
  protected
    property StdOutRead : THandle read fOutputRead;
    property StdInWrite : THandle read fInputWrite;
    property StdErrRead : THandle read fErrorRead;
    procedure PrepareStartupInformation (var info : TStartupInfo);

  public
    constructor Create (AOwner : TComponent); override;
    destructor Destroy; override;

    procedure Run (fileName, cmdLine, directory : string);
    procedure AddInputText (const st : string);
    procedure Terminate;

    property ReturnValue : DWORD read fReturnValue;
    property OutputText : TStrings read fOutputText;
    property ErrorText : TStrings read fErrorText;
    property Running : boolean read fRunning;


  published
    property OnOutputText : TOnText read fOnOutputText write fOnOutputText;
    property OnErrorText : TOnText read fOnErrorText write fOnErrorText;
    property OnTerminate : TNotifyEvent read fOnTerminate write 
fOnTerminate;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Misc Units', [TStdIORedirect]);
end;

type

TStdIOInputThread = class (TThread)
private
  fParent : TStdIORedirect;
protected
  procedure Execute; override;
public
  constructor Create (AParent : TStdIORedirect);
end;

TStdIOOutputThread = class (TThread)
private
  fParent : TStdIORedirect;
protected
  procedure Execute; override;
public
  constructor Create (AParent : TStdIORedirect);
end;

{ TStdIORedirect }

procedure TStdIORedirect.AddInputText(const st: string);
begin
  fInputText.Add (st);
  fInputEvent.SetEvent
end;

constructor TStdIORedirect.Create(AOwner: TComponent);
begin
  inherited Create (AOwner);
  fOutputText := TStringList.Create;
  fErrorText := TStringList.Create;
  fInputText := TStringList.Create;
  fInputEvent := TEvent.Create (Nil, False, False, '');
end;


procedure TStdIORedirect.CreateHandles;
var
  sa : TSecurityAttributes;
  hOutputReadTmp, hErrorReadTmp, hInputWriteTmp : THandle;

begin
  DestroyHandles;

  sa.nLength := sizeof (sa);
  sa.lpSecurityDescriptor := Nil;
  sa.bInheritHandle := True;

  if not CreatePipe (hOutputReadTmp, fOutputWrite, @sa, 0) then
    RaiseLastWin32Error;

  if not CreatePipe (hErrorReadTmp, fErrorWrite, @sa, 0) then
    RaiseLastWin32Error;

  if not CreatePipe (fInputRead, hInputWriteTmp, @sa, 0) then
    RaiseLastWin32Error;

  if not DuplicateHandle (GetCurrentProcess, hOutputReadTmp, 
GetCurrentProcess, @fOutputRead, 0, FALSE, DUPLICATE_SAME_ACCESS) then
    RaiseLastWin32Error;

  if not DuplicateHandle (GetCurrentProcess, hErrorReadTmp, 
GetCurrentProcess, @fErrorRead, 0, FALSE, DUPLICATE_SAME_ACCESS) then
    RaiseLastWin32Error;

  if not DuplicateHandle (GetCurrentProcess, hInputWriteTmp, 
GetCurrentProcess, @fInputWrite, 0, FALSE, DUPLICATE_SAME_ACCESS) then
    RaiseLastWin32Error;

  CloseHandle (hOutputReadTmp);
  CloseHandle (hErrorReadTmp);
  CloseHandle (hInputWriteTmp);

  fOutputStream := TMemoryStream.Create;
  fErrorStream := TMemoryStream.Create;
  fOutputStreamPos := 0;
  fErrorStreamPos := 0;

  fOutputText.Clear;
  fErrorText.Clear;
end;

destructor TStdIORedirect.Destroy;
begin
  DestroyHandles;
  fOutputText.Free;
  fErrorText.Free;
  fInputEvent.Free;
  fInputText.Free;
  inherited;
end;

procedure TStdIORedirect.DestroyHandles;
begin
  if fInputRead <> 0 then CloseHandle (fInputRead);
  if fOutputRead <> 0 then CloseHandle (fOutputRead);
  if fErrorRead <> 0 then CloseHandle (fErrorRead);

  if fInputWrite <> 0 then CloseHandle (fInputWrite);
  if fOutputWrite <> 0 then CloseHandle (fOutputWrite);
  if fErrorWrite <> 0 then CloseHandle (fErrorWrite);

  fInputRead := 0;
  fOutputRead := 0;
  fErrorRead := 0;

  fInputWrite := 0;
  fOutputWrite := 0;
  fErrorWrite := 0;

  fErrorStream.Free; fErrorStream := Nil;
  fOutputStream.Free; fOutputStream := Nil;
end;

procedure TStdIORedirect.HandleOutput;
var
  ch : char;
begin
  fOutputStream.Position := fOutputStreamPos;

  while fOutputStream.Position < fOutputStream.Size do
  begin
    fOutputStream.Read (ch, sizeof (ch));
    case ch of
      #13 :
        begin
          fOutputText.Add (fOutputLineBuff);
          if Assigned (OnOutputText) then
            OnOutputText (self, fOutputLineBuff);
          fOutputLineBuff := '';
        end;

      #0..#12, #14..#31 :;

      else
        fOutputLineBuff := fOutputLineBuff + ch
    end
  end;

  fOutputStreamPos := fOutputStream.Position;

  fErrorStream.Position := fErrorStreamPos;

  while fErrorStream.Position < fErrorStream.Size do
  begin
    fErrorStream.Read (ch, sizeof (ch));
    case ch of
      #13 :
        begin
          fErrorText.Add (fErrorLineBuff);
          if Assigned (OnErrorText) then
            OnErrorText (self, fErrorLineBuff);
          fErrorLineBuff := '';
        end;

      #0..#12, #14..#31 :;

      else
        fErrorLineBuff := fErrorLineBuff + ch
    end
  end;

  fErrorStreamPos := fErrorStream.Position;

end;

procedure TStdIORedirect.PrepareStartupInformation(
  var info: TStartupInfo);
begin
  info.cb := sizeof (info);
  info.dwFlags := info.dwFlags or STARTF_USESTDHANDLES;
  info.hStdInput := fInputRead;
  info.hStdOutput := fOutputWrite;
  info.hStdError := fErrorWrite;
end;

procedure TStdIORedirect.Run(fileName, cmdLine, directory: string);
var
  startupInfo : TStartupInfo;
  pOK : boolean;
  fName, cLine, dir : PChar;
begin
  if not Running then
  begin
    FillChar (startupInfo, sizeof (StartupInfo), 0);
    CreateHandles;
    PrepareStartupInformation (startupInfo);

    if fileName <> '' then fName := PChar (fileName) else fName := Nil;
    if cmdLine <> '' then cLine := PChar (cmdLine) else cLine := Nil;
    if directory <> '' then dir := PChar (directory) else dir := Nil;

    pOK := CreateProcess (fName, cLine, Nil, Nil, True,
                          CREATE_NO_WINDOW, Nil,
                          dir, startupInfo,fProcessInfo);

    CloseHandle (fOutputWrite); fOutputWrite := 0;
    CloseHandle (fInputRead); fInputRead := 0;
    CloseHandle (fErrorWrite); fErrorWrite := 0;

    if pOK then
    begin
      fRunning := True;
      try
        TStdIOInputThread.Create (self);
        TStdIOOutputThread.Create (self);
        while MsgWaitForMultipleObjects (1, fProcessInfo.hProcess, False,INFINITE, QS_ALLINPUT) = WAIT_OBJECT_0 + 1 do
          Application.ProcessMessages;

        if not GetExitCodeProcess (fProcessInfo.hProcess, fReturnValue) then
          RaiseLastWin32Error;


      finally
        fInputText.Clear;
        CloseHandle (fProcessInfo.hThread);
        CloseHandle (fProcessInfo.hProcess);
        fRunning := False;
        if Assigned (OnTerminate) then
          OnTerminate (self);
      end;
    end
    else
      RaiseLastWin32Error
  end
end;

procedure TStdIORedirect.Terminate;
begin
  if Running then
    TerminateProcess (fProcessInfo.hProcess, 0);
end;

{ TStdIOInputThread }

constructor TStdIOInputThread.Create(AParent: TStdIORedirect);
begin
  inherited Create (True);
  FreeOnTerminate := True;
  fParent := AParent;
  Resume
end;

function CopyTextToPipe (handle : THandle; text : TStrings) : boolean;
var
  i : Integer;
  st : string;
  bytesWritten : DWORD;
  p : Integer;
  bTerminate : boolean;
begin
  bTerminate := False;
  for i := 0 to text.Count - 1 do
  begin
    st := text [i];
    p := Pos (#26, st);
    if p > 0 then
    begin
      st := Copy (st, 1, p - 1);
      bTerminate := True;
    end
    else
      st := st + #13#10;

    if st <> '' then
      if not WriteFile (handle, st [1], Length (st), bytesWritten, Nil) then
        if GetLastError <> ERROR_NO_DATA then
          RaiseLastWin32Error;

  end;
  result := bTerminate;
  text.Clear
end;

procedure TStdIOInputThread.Execute;
var
  objects : array [0..1] of THandle;
  objectNo : DWORD;
begin
  if fParent.fInputText.Count > 0 then
    fParent.fInputEvent.SetEvent;

  objects [0] := fParent.fProcessInfo.hProcess;
  objects [1] := fParent.fInputEvent.Handle;

  while True do
  begin
    objectNo := WaitForMultipleObjects (2, @objects [0], False, INFINITE);

    case objectNo of
      WAIT_OBJECT_0 + 1 :
        if CopyTextToPipe (fParent.fInputWrite, fParent.fInputText) then
        begin
          CloseHandle (fParent.fInputWrite);
          fParent.fInputWrite := 0;
          break
        end;
      else
        break;
    end
  end
end;

{ TStdIOOutputThread }

constructor TStdIOOutputThread.Create(AParent: TStdIORedirect);
begin
  inherited Create (True);
  FreeOnTerminate := True;
  fParent := AParent;
  Resume
end;

procedure TStdIOOutputThread.Execute;
var
  buffer : array [0..1023] of char;
  bytesRead : DWORD;

begin
  while ReadFile (fParent.fOutputRead, buffer, 1024, bytesRead, Nil) and 
(bytesRead > 0) do
  begin
    fParent.fOutputStream.Seek (0, soFromEnd);
    fParent.fOutputStream.Write (buffer [0], bytesRead);
    Synchronize (fParent.HandleOutput)
  end
end;

end.

Ein Problem nur: manchmal bekomme ich die Ausgabe auf stdout nicht mit - das Programm ist scheinabr zu schnell. Jemand eine Lösung?

Danke!

Tschau