run dos app and capture all of the text when the app is running

Hello everyone

I  have a function to execute dos app and display the output

function ExecRD (const cmdline : String; Timeout :Dword):String;

it wroks well.

Now it just dumps the text out to pipe, but  I  need capture all of the text that display when it is running rather than it have completed the procress.

Welcome any comment.

Thanks

interdev
function OEMToStr(const OEM : String):String;
begin
  SetLength(Result, Length(OEM));
  OEMToChar(Pointer(OEM), Pointer(Result));
end;
 
function ExecRD (const cmdline : String; Timeout :Dword):String;
var
   hReadPipe,
   hWritePipe: THandle;
  saPipe: TSecurityAttributes;
 
  StartInfo: TStartupInfo;
  ProcInfo: TProcessInformation;
 
  Params : ThreadParams;
  ReaderID : Dword;
  ReaderHandle : THandle;
      
 
 
begin
  Result := '';
  ReaderHandle := 0;
 
  saPipe.bInheritHandle := True;
  saPipe.lpSecurityDescriptor := nil;
  saPipe.nLength := SizeOf(saPipe);
 
  if not CreatePipe(hReadPipe,hWritePipe, @saPipe,0) then
    RaiseLastWin32Error;
 
  FillChar(StartInfo,SizeOf(StartInfo),0);
  StartInfo.dwFlags:= STARTF_USESTDHANDLES  or
                      STARTF_USESHOWWINDOW;
  StartInfo.wShowWindow:=SW_HIDE;
  StartInfo.hStdOutput:= hWritePipe;
  StartInfo.hStdError:= hWritePipe;
  StartInfo.cb:=SizeOf(StartInfo);
 
                              
  try
 
  Params.hReadPipe := hReadPipe;
 
  ReaderHandle := CreateThread( nil,
                                0,
                                @ThreadRead,
                                @Params,
                                0,
                                ReaderId);
 
 
  if ReaderHandle = 0 then
    RaiseLastWin32Error;
 
  if CreateProcess(nil,
                   PChar(cmdline),
                    nil,
                    nil,
                   True,
                   NORMAL_PRIORITY_CLASS,//0,
                   nil,
                   nil,
                   StartInfo,
                   ProcInfo) then
    begin
      CloseHandle(ProcInfo.hThread);
      CloseHandle(hWritePipe);
    end
  else
    RaiseLastWin32Error;
 
  if WaitForSingleObject(ReaderHandle, Timeout) = WAIT_TIMEOUT then
     begin
       TerminateThread(ReaderHandle,0);
       TerminateProcess(ProcInfo.hProcess, 1);
       Result := 'Process is terminated.'#13#10;
     end;
 
 
 
 
 
  Result := OEMToStr(Result+Params.s);
 
  finally
    if ReaderHandle > 0 then
       CloseHandle(ReaderHandle);
    if ProcInfo.hProcess > 0 then
       CloseHandle(ProcInfo.hProcess);
    if hReadPipe > 0 then
       CloseHandle(hReadPipe);
  end;
end;

Open in new window

interdevAsked:
Who is Participating?
 
ThievingSixCommented:
This is what I am using now:

Usage:
var
  MyDosBox : TDosBox;
begin
  MyDosBox := TDosBox.Create(0,0,'chkdsk.exe C:',OutMemo,True);
end;
unit uDosBoxThread;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, StdCtrls, uFormatOutput;
 
const
  WM_DOSTERMINATED = WM_USER + $1337;
 
type
  TDosBoxThread = class(TThread)
  private
    FFormattedOutput : TFormattedOutput;
    FOutData : String;
    FProcessInformation : TProcessInformation;
    procedure UpdateMemo;
    procedure RunDosInMemo(DosApp: String);
  protected
    procedure Execute; override;
  public
    AMemo : TMemo;
    DosFileName : String;
  end;
 
  TDosBox = class(TObject)
  private
    FID : DWORD;
    FOwner : HWND;
    FDosBoxThread : TDosBoxThread;
    FTerminateOnFinish : Boolean;
  protected
    procedure OnTerminate(Sender: TObject);
    function ThreadedDosInMemo(DosFileName: String; AMemo: TMemo): TDosBoxThread;
  public
    property DosBoxThread : TDosBoxThread read FDosBoxThread write FDosBoxThread;
    constructor Create(Owner: HWND; ID: DWORD; DosFileName: PAnsiChar; AMemo: TMemo; TerminateOnFinish: Boolean = True);
    destructor Destroy; override;
  end;
 
implementation
 
uses uFunctions;
 
constructor TDosBox.Create(Owner: HWND; ID: DWORD; DosFileName: PAnsiChar; AMemo: TMemo; TerminateOnFinish: Boolean = True);
begin
  inherited Create;
  FOwner := Owner;
  FID := ID;
  FTerminateOnFinish := TerminateOnFinish;
  FDosBoxThread := ThreadedDosInMemo(DosFileName,AMemo);
end;
 
destructor TDosBox.Destroy;
begin
  FreeAndNil(FDosBoxThread);
  inherited Destroy;
end;
 
function TDosBox.ThreadedDosInMemo(DosFileName: String; AMemo: TMemo): TDosBoxThread;
begin
  Result := TDosBoxThread.Create(True);
  Result.AMemo := AMemo;
  Result.DosFileName := DosFileName;
  Result.FreeOnTerminate := True;
  Result.OnTerminate := OnTerminate;
  Result.Resume;
end;
 
procedure TDosBox.OnTerminate(Sender: TObject);
begin
  Try
    If FTerminateOnFinish Then
      begin
      CloseAppOrTerminate(FDosBoxThread.FProcessInformation.hProcess,FDosBoxThread.FProcessInformation.dwProcessId);
    end;
  Finally
    CloseHandle(FDosBoxThread.FProcessInformation.hProcess);
    CloseHandle(FDosBoxThread.FProcessInformation.hThread);
    PostMessage(FOwner,WM_DOSTERMINATED,FID,0);
  end;
end;
 
procedure TDosBoxThread.RunDosInMemo(DosApp: String);
const
  ReadBuffer = 4096;
var
  SecurityAttributes : TSecurityAttributes;
  ReadPipe, WritePipe : DWORD;
  StartupInfo : TStartupInfo;
  ProcessInformation : TProcessInformation;
  Buffer : PChar;
  BytesRead : DWORD;
  BytesToRead : DWORD;
  BytesWritten : DWORD;
begin
  FFormattedOutput := TFormattedOutput.Create([#10,#13]);
  FFormattedOutput.BeginUpdate(AMemo.Lines);
  With SecurityAttributes Do
    begin
    nLength := SizeOf(TSecurityAttributes);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;
  If CreatePipe(ReadPipe,WritePipe,@SecurityAttributes,0) Then
    begin
    Try
      Buffer := AllocMem(ReadBuffer + 1);
      If Buffer = nil Then LastError;
      Try
        FillChar(StartupInfo,Sizeof(StartupInfo),0);
        StartupInfo.cb := SizeOf(StartupInfo);
        StartupInfo.hStdOutput := WritePipe;
        StartupInfo.hStdInput := ReadPipe;
        StartupInfo.hStdError := ReadPipe;
        StartupInfo.dwFlags := STARTF_USESTDHANDLES OR STARTF_USESHOWWINDOW;
        StartupInfo.wShowWindow := SW_HIDE;
        If CreateProcess(nil,PChar(DosApp),@SecurityAttributes,@SecurityAttributes,True,NORMAL_PRIORITY_CLASS,nil,nil,StartupInfo,ProcessInformation) Then
          begin
          FProcessInformation := ProcessInformation;
          Repeat
            BytesRead := 0;
            BytesToRead := 0;
            If Not(PeekNamedPipe(ReadPipe,nil,0,nil,@BytesToRead,nil)) Then
              begin
              Break;
            end;
            If BytesToRead > 0 Then
              begin
              If Not(ReadFile(ReadPipe,Buffer^,BytesToRead,BytesRead,nil)) Then LastError;
              OemToChar(Buffer,Buffer);
              SetLength(FOutData,BytesRead);
              Move(Buffer^,FOutData[1],BytesRead);
              If Pos('Press any key to continue . . .',FOutData) > 0 Then
                begin
                Buffer[0] := #13;
                Buffer[1] := #0;
                CharToOem(Buffer,Buffer);
                WriteFile(WritePipe,Buffer^,2,BytesWritten,nil);
                FOutData := 'Program has ended!';
              end;
              Synchronize(UpdateMemo);
            end;
          Until ((GetExitCodeProcess(ProcessInformation.hProcess) <> STILL_ACTIVE) And (BytesToRead = 0) Or (Terminated));
        end
        Else
          begin
          LastError;
        end;
      Finally
        FreeMem(Buffer);
      end;
    Finally
      CloseHandle(ReadPipe);
      CloseHandle(WritePipe);
      FFormattedOutput.EndUpdate;
      FreeAndNil(FFormattedOutput);
    end;
  end
  Else
    begin
    LastError;
  end;
end;
 
procedure TDosBoxThread.UpdateMemo;
begin
  FFormattedOutput.Add(FOutData);
end;
 
procedure TDosBoxThread.Execute;
begin
  RunDosInMemo(DosFileName);
end;
 
end.

Open in new window

0
 
interdevAuthor Commented:
another hint

when the function call the dos app, my program look likes dead and no reponse, even I try to call a timer to display the hreadpipe contents, the timer only works after the dos app has completed its process.
0
 
interdevAuthor Commented:
what is unit  uFormatOutput?

Thanks
0
Cloud Class® Course: CompTIA Cloud+

The CompTIA Cloud+ Basic training course will teach you about cloud concepts and models, data storage, networking, and network infrastructure.

 
interdevAuthor Commented:
and what is ufunctions?
0
 
ThievingSixCommented:
Ah, damn completely forgot about those.

Here is uFunctions.pas
unit uFunctions;
 
interface
 
uses
  Windows, Dialogs, SysUtils, Messages, Classes;
 
procedure LastError;
function GetExitCodeProcess(hProcess: DWORD): DWORD;
function IsStringSame(const String1, String2: String): Boolean;
function TrimSpaces(InStr: String): String;
function GetVersion: String;
function SecToTime(Sec: DWORD): String;
procedure CloseAppOrTerminate(hProcess: DWORD; PID: DWORD);
function GetTokenRange(Tokens: TStringList; FromNum, ToNum: Integer): String;
procedure ParseInput(Input: String; var Command: String; Tokens: TStringList);
 
implementation
 
procedure LastError;
begin
  ShowMessage(SysErrorMessage(GetLastError));
end;
 
function GetTokenRange(Tokens: TStringList; FromNum, ToNum: Integer): String;
var
  I : Integer;
begin
  Result := '';
  If Tokens.Count < ToNum Then Exit;
  For I := FromNum To ToNum Do
    begin
    Result := Result + Tokens.Strings[I] + #32;
  end;
  Delete(Result,Length(Result),1);
end;
 
procedure ParseInput(Input: String; var Command: String; Tokens: TStringList);
var
  Data : String;
begin
  Data := TrimSpaces(Input);
  If Not(Assigned(Tokens)) Then
    begin
    Tokens := TStringList.Create;
  end;
  Tokens.Clear;
  If Data[1] <> '/' Then
    begin
    Command := '/say';
    Tokens.Text := Data;
  end
  Else
    begin
    If Pos(#32,Data) = 0 Then
      begin
      Command := Data;
    end
    Else
      begin
      Command := Copy(Data,1,Pos(#32,Data) - 1);
      Data := Copy(Data,Pos(#32,Data) + 1,MAXINT);
      Repeat
        If Pos(#32,Data) = 0 Then
          begin
          Tokens.Add(Data);
          Data := '';
        end
        Else
          begin
          Tokens.Add(Copy(Data,1,Pos(#32,Data) - 1));
          Data := Copy(Data,Pos(#32,Data) + 1,MAXINT);
        end;
      Until (Length(Data) = 0);
    end;
  end;
end;
 
function GetExitCodeProcess(hProcess: DWORD): DWORD;
begin
  If Not Windows.GetExitCodeProcess(hProcess,Result) Then
    begin
    LastError;
  end;
end;
 
function IsStringSame(const String1, String2: String): Boolean;
begin
  Result := CompareString(LOCALE_SYSTEM_DEFAULT,NORM_IGNORECASE,PChar(String1),-1,PChar(String2),-1) = 2;
end;
 
function TrimSpaces(InStr: String): String;
begin
  Result := InStr;
  While Result[1] = #32 Do
    begin
    Delete(Result,1,1);
  end;
  While Result[Length(Result)] = #32 Do
    begin
    Delete(Result,Length(Result),1);
  end;
end;
 
function GetVersion: String;
var
  VerInfoSize: DWORD;
  VerInfo: Pointer;
  VerValueSize: DWORD;
  VerValue: PVSFixedFileInfo;
  Dummy: DWORD;
begin
  VerInfoSize := GetFileVersionInfoSize(PChar(ParamStr(0)),Dummy);
  GetMem(VerInfo,VerInfoSize);
  GetFileVersionInfo(PChar(ParamStr(0)),0,VerInfoSize,VerInfo);
  VerQueryValue(VerInfo,'\',Pointer(VerValue),VerValueSize);
  with VerValue^ Do
    begin
    Result := IntToStr(dwFileVersionMS shr 16);
    Result := Result + '.' + IntToStr(dwFileVersionMS and $FFFF);
    Result := Result + '.' + IntToStr(dwFileVersionLS shr 16);
    Result := Result + '.' + IntToStr(dwFileVersionLS and $FFFF);
  end;
  FreeMem(VerInfo,VerInfoSize);
end;
 
function SecToTime(Sec: DWORD): String;
var
  ZD, ZH, ZM, ZS: DWORD;
begin
  ZD := Sec div 86400;
  ZH := Sec div 3600 - ZD;
  ZM := Sec div 60 - ZH * 60;
  ZS := Sec - (ZH * 3600 + ZM * 60);
  Result := Format('%.2d:%.2d:%.2d:%.2d',[ZD,ZH,ZM,ZS]);
end;
 
function TerminateEnum(Wnd: HWND; dwData: DWORD): Boolean;
var
  PID: DWORD;
begin
  GetWindowThreadProcessID(Wnd,PID);
  If PID = dwData Then
    begin
    PostMessage(Wnd,WM_CLOSE,0,0);
    Result := False;
  end   
  Else
    begin
    Result := True;
  end; 
end;
 
procedure CloseAppOrTerminate(hProcess: DWORD; PID: DWORD);
var
  ExitCode : DWORD;
begin
  ExitCode := GetExitCodeProcess(hProcess);
  If ExitCode = STILL_ACTIVE Then
    begin
    EnumWindows(@TerminateEnum,PID);
    If WaitForSingleObject(hProcess,4096) <> WAIT_OBJECT_0  Then
      begin
      TerminateProcess(hProcess,0);
    end;
  end;
end;
 
end.

Open in new window

0
 
ThievingSixCommented:
uFormattedOutput.pas:
unit uFormatOutput;
 
interface
 
uses
  Windows, Classes, SysUtils;
 
type
  TAnsiCharSet = Set of AnsiChar;
  TFormattedOutput = class(TObject)
  private
     FChars : TAnsiCharSet;
     FLines : TStrings;
     FBuffer : String;
  protected
     procedure Clear;
     function ScanChars(Source: PChar): PChar;
  public
     constructor Create(TermChars: TAnsiCharSet);
     destructor Destroy; override;
     procedure Add(Data: String);
     procedure BeginUpdate(Lines: TStrings);
     procedure EndUpdate;
  end;
 
implementation
 
procedure TFormattedOutput.Add(Data: String);
var
  lpszBuffer : PChar;
  lpszScan : PChar;
  szLine : String;
  dwSize : Integer;
begin
  If Assigned(FLines) Then
    begin
    FBuffer := FBuffer + Data;
    If Length(FBuffer) > 0 Then
      begin
      dwSize := 0;
      lpszBuffer := Pointer(FBuffer);
      FLines.BeginUpdate;
      Try
        lpszScan := ScanChars(lpszBuffer);
        While Assigned(lpszScan) Do
          begin
          Inc(lpszScan);
          While (lpszScan^ > #0) And (lpszScan^ in FChars) Do
            begin
            Inc(lpszScan);
          end;
          Inc(dwSize,lpszScan - lpszBuffer);
          SetString(szLine,lpszBuffer,lpszScan - lpszBuffer);
          FLines.Add(TrimRight(szLine));
          lpszBuffer := lpszScan;
          lpszScan := ScanChars(lpszBuffer);
        end;
        If (dwSize > 0) Then
          begin
          Delete(FBuffer, 1, dwSize);
        end;
      Finally
        FLines.EndUpdate;
      end;
    end;
  end;
end;
 
procedure TFormattedOutput.BeginUpdate(Lines: TStrings);
begin
  Clear;
  FLines := Lines;
end;
 
procedure TFormattedOutput.EndUpdate;
begin
  Try
    If Assigned(FLines) And (Length(FBuffer) > 0) Then
      begin
      FLines.Add(FBuffer);
    end;
  Finally
    Clear;
  end;
end;
 
function TFormattedOutput.ScanChars(Source: PChar): PChar;
begin
  Result := nil;
  If Assigned(Source) Then
    begin
    While (Source^ > #0) Do
      begin
      If (Source^ in FChars) Then
        begin
        Result := Source;
        break;
      end;
      Inc(Source);
    end;
  end;
end;
 
procedure TFormattedOutput.Clear;
begin
  SetLength(FBuffer,0);
  FLines := nil;
end;
 
constructor TFormattedOutput.Create(TermChars: TAnsiCharSet);
begin
  inherited Create;
  FChars := TermChars;
  Clear;
end;
 
destructor TFormattedOutput.Destroy;
begin
  EndUpdate;
  inherited Destroy;
end;
 
end.

Open in new window

0
 
interdevAuthor Commented:
Thanks a lot.
But it look likes has the same function with my codes.

 I  need capture all of the run-time text  display one by one when it is running rather than it have completed the procress.


Best Regards

interdev
0
 
interdevAuthor Commented:
sorry it do what I want

but there is one question:

if I need run an app with file path and parameter

for example:

c:\program files\a.exe -s b.txt


there is space in the string

so I set

s:="c:\program files\a.exe -s b.txt";

then call

MyDosBox := TDosBox.Create(0,0,s,OutMemo,True);

it does not work




0
 
ThievingSixCommented:
Hmm, it should work just fine because I use 'chkdsk C:' for my testings when I was doing it and that has a parameter and space.

Try: s:='"c:\program files\a.exe" -s b.txt';
0
 
interdevAuthor Commented:
Thanks a lot


Cheers

interdev
0
 
interdevAuthor Commented:
I checked

if s:='"c:\program files\a.exe" -s b.txt';

the code that executes:
//--------------------------------------------------------------------------------
If Not(PeekNamedPipe(ReadPipe,nil,0,nil,@BytesToRead,nil)) Then

bytestoread always return 0 which cause the

repeat until breaks

I do not know the reason

interdev
             
0
 
ThievingSixCommented:
It its returning 0 then it's not outputting any text. Does the program need any user intermission such as pressing the enter key at any time?

0
 
interdevAuthor Commented:
Everything is OK now.

There is still a question:

How to know the thread that runs the dos app is finished?

Best Regards

interdev
0
 
ThievingSixCommented:
procedure TDosBox.OnTerminate(Sender: TObject);
0
 
interdevAuthor Commented:
in my form, I wrote:

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

const
WM_DOSTERMINATED=WM_USER +$1337;
.......


type
   tmyform=class(tform)
   ....
   private
       procedure ondosterminated(var:tmessage);message WM_DOSTERMINATED;

end;

procedure tmyform.ondosterminated (var  msg:tmessage);
begin

my codes;//my break point

end;

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

I also set the break point at
PostMessage(FOwner,WM_DOSTERMINATED,FID,0);
in tdosbox.onterminate

when dos app is finished, it prompts

PostMessage(FOwner,WM_DOSTERMINATED,FID,0);

but it does not reach my break point in

procedure tmyform.ondosterminated (var  msg:tmessage);


interdev


0
 
ThievingSixCommented:
On the TDosBox.Create did you pass the handle of your form?
0
 
interdevAuthor Commented:
It works

Cheers

interdev
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.