We help IT Professionals succeed at work.

We've partnered with Certified Experts, Carl Webster and Richard Faulkner, to bring you two Citrix podcasts. Learn about 2020 trends and get answers to your biggest Citrix questions!Listen Now

x

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

interdev
interdev asked
on
Medium Priority
328 Views
Last Modified: 2013-11-05
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

Comment
Watch Question

Author

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.
Developer
CERTIFIED EXPERT
Commented:
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

Not the solution you were looking for? Getting a personalized solution is easy.

Ask the Experts

Author

Commented:
what is unit  uFormatOutput?

Thanks

Author

Commented:
and what is ufunctions?
ThievingSixDeveloper
CERTIFIED EXPERT

Commented:
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

ThievingSixDeveloper
CERTIFIED EXPERT

Commented:
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

Author

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

Author

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




ThievingSixDeveloper
CERTIFIED EXPERT

Commented:
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';

Author

Commented:
Thanks a lot


Cheers

interdev

Author

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
             
ThievingSixDeveloper
CERTIFIED EXPERT

Commented:
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?

Author

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
ThievingSixDeveloper
CERTIFIED EXPERT

Commented:
procedure TDosBox.OnTerminate(Sender: TObject);

Author

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


ThievingSixDeveloper
CERTIFIED EXPERT

Commented:
On the TDosBox.Create did you pass the handle of your form?

Author

Commented:
It works

Cheers

interdev
Access more of Experts Exchange with a free account
Thanks for using Experts Exchange.

Create a free account to continue.

Limited access with a free account allows you to:

  • View three pieces of content (articles, solutions, posts, and videos)
  • Ask the experts questions (counted toward content limit)
  • Customize your dashboard and profile

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.