Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

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

Posted on 2009-02-08
17
Medium Priority
?
309 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

0
Comment
Question by:interdev
  • 10
  • 7
17 Comments
 

Author Comment

by:interdev
ID: 23587533
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
 
LVL 13

Accepted Solution

by:
ThievingSix earned 2000 total points
ID: 23587722
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
 

Author Comment

by:interdev
ID: 23587948
what is unit  uFormatOutput?

Thanks
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:interdev
ID: 23587956
and what is ufunctions?
0
 
LVL 13

Expert Comment

by:ThievingSix
ID: 23588098
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
 
LVL 13

Expert Comment

by:ThievingSix
ID: 23588099
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
 

Author Comment

by:interdev
ID: 23588262
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
 

Author Comment

by:interdev
ID: 23588277
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
 
LVL 13

Expert Comment

by:ThievingSix
ID: 23588422
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
 

Author Closing Comment

by:interdev
ID: 31544403
Thanks a lot


Cheers

interdev
0
 

Author Comment

by:interdev
ID: 23591805
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
 
LVL 13

Expert Comment

by:ThievingSix
ID: 23594016
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
 

Author Comment

by:interdev
ID: 23628738
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
 
LVL 13

Expert Comment

by:ThievingSix
ID: 23629160
procedure TDosBox.OnTerminate(Sender: TObject);
0
 

Author Comment

by:interdev
ID: 23629445
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
 
LVL 13

Expert Comment

by:ThievingSix
ID: 23629649
On the TDosBox.Create did you pass the handle of your form?
0
 

Author Comment

by:interdev
ID: 23629850
It works

Cheers

interdev
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
With just a little bit of  SQL and VBA, many doors open to cool things like synchronize a list box to display data relevant to other information on a form.  If you have never written code or looked at an SQL statement before, no problem! ...  give i…
Kernel Data Recovery is a renowned Data Recovery solution provider which offers wide range of softwares for both enterprise and home users with its cost-effective solutions. Let's have a quick overview of the journey and data recovery tools range he…
Suggested Courses

578 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question