Memo get real-time output

[kvk1989 2]

Hi, 

I'm trying to get real-time in memo 

Here codes 

function GetDosOutput(CommandLine: string; Work: string = 'C:\'): string;
var
  SA: TSecurityAttributes;
  SI: TStartupInfo;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array[0..255] of AnsiChar;
  BytesRead: Cardinal;
  WorkDir: string;
  Handle: Boolean;
begin
  Result := '';
  with SA do begin
    nLength := SizeOf(SA);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;
  CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);
  try
    with SI do
    begin
      FillChar(SI, SizeOf(SI), 0);
      cb := SizeOf(SI);
      dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      wShowWindow := SW_HIDE;
      hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
      hStdOutput := StdOutPipeWrite;
      hStdError := StdOutPipeWrite;
    end;
    WorkDir := Work;
    Handle := CreateProcess(nil, PChar('cmd.exe /C ' + CommandLine),
                            nil, nil, True, 0, nil,
                            PChar(WorkDir), SI, PI);
    CloseHandle(StdOutPipeWrite);
    if Handle then
      try
        repeat
          WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
          if BytesRead > 0 then
          begin
            Buffer[BytesRead] := #0;
            Result := Result + Buffer;
          end;
        until not WasOK or (BytesRead = 0);
        WaitForSingleObject(PI.hProcess, INFINITE);
      finally
        CloseHandle(PI.hThread);
        CloseHandle(PI.hProcess);
      end;
  finally
    CloseHandle(StdOutPipeRead);
  end;
end;
procedure TForm7.Button1Click(Sender: TObject);

begin

Memo1.Text:= GetDosOutput('python mtk payload',
      ExtractFilePath(application.ExeName) + 'bin\');

end;

end.

[FPiette 367]

You should explain what you want to do, what is the problem in your code and which part you don't know how to do.

[kvk1989 2]

17 minutes ago, FPiette said:

You should explain what you want to do, what is the problem in your code and which part you don't know how to do.

Hi, code working fine but memo output very late

[Fr0sT.Brutal 897]

You run an app, read its output, wait for it to finish and then assign output as text to memo. Code is working just as you told it to

[Remy Lebeau 1267]

6 hours ago, kvk1989 said:

Hi, code working fine but memo output very late

That is because you are not writing to the Memo while the reading loop is running.  You are writing to the Memo only after the loop is finished.

 

Change the code to write the current Buffer to the Memo after each successful read.  And don't use the Memo.Text property to do that update, either.  That will be very inefficient.  A better way to append text to the end of a Memo is to use its SelText property instead, eg:

procedure GetDosOutput(Output: TMemo; CommandLine: string; Work: string);
var
  ...
begin
  ...
  repeat
    WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
    if WasOK and (BytesRead > 0) then
    begin
      Buffer[BytesRead] := #0;
      Output.SelStart := Output.GetTextLen;
      Output.SelLength := 0;
      Output.SelText := Buffer;
    end;
  until (not WasOK) or (BytesRead = 0);
  ...
end;

procedure TForm7.Button1Click(Sender: TObject);
begin
  GetDosOutput(Memo1, 'python mtk payload', ExtractFilePath(application.ExeName) + 'bin\');
end;

If you don't want to pass in the TMemo directly, you could pass in a TStream instead, and then write a custom TStream descendant that overwrites the virtual Write() method to append to the Memo, eg:

procedure GetDosOutput(Output: TStream; CommandLine: string; Work: string);
var
  ...
begin
  ...
  repeat
    WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
    if WasOK and (BytesRead > 0) then
      Output.WriteBuffer(Buffer, BytesRead);
  until (not WasOK) or (BytesRead = 0);
  ...
end;

type
  TMemoAppendStream = class(TStream)
  private
    FMemo: TMemo;
  public
    constructor Create(AMemo: TMemo);
    function Write(const Buffer; Count: Longint): Longint; override;
  end;

constructor TMemoAppendStream.Create(AMemo: TMemo);
begin
  inherited Create;
  FMemo := AMemo;
end;

function TMemoAppendStream.Write(const Buffer; Count: Longint): Longint;
var
  BufferStr: AnsiString;
begin
  Result := Count;
  SetString(BufferStr, PAnsiChar(@Buffer), Count);
  FMemo.SelStart := FMemo.GetTextLen;
  FMemo.SelLength := 0;
  FMemo.SelText := BufferStr;
end;

procedure TForm7.Button1Click(Sender: TObject);
var
  Strm: TMemoAppendStream;
begin
  Strm := TMemoAppendStream.Create(Memo1);
  try
    GetDosOutput(Strm, 'python mtk payload', ExtractFilePath(application.ExeName) + 'bin\');
  finally
    Strm.Free;
  end;
end;

 

Edited February 4, 2022 by Remy Lebeau

[kvk1989 2]

12 hours ago, Remy Lebeau said:

That is because you are not writing to the Memo while the reading loop is running.  You are writing to the Memo only after the loop is finished.

 

Change the code to write the current Buffer to the Memo after each successful read.  And don't use the Memo.Text property to do that update, either.  That will be very inefficient.  A better way to append text to the end of a Memo is to use its SelText property instead, eg:

procedure GetDosOutput(Output: TMemo; CommandLine: string; Work: string);
var
  ...
begin
  ...
  repeat
    WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
    if WasOK and (BytesRead > 0) then
    begin
      Buffer[BytesRead] := #0;
      Output.SelStart := Output.GetTextLen;
      Output.SelLength := 0;
      Output.SelText := Buffer;
    end;
  until (not WasOK) or (BytesRead = 0);
  ...
end;

procedure TForm7.Button1Click(Sender: TObject);
begin
  GetDosOutput(Memo1, 'python mtk payload', ExtractFilePath(application.ExeName) + 'bin\');
end;

If you don't want to pass in the TMemo directly, you could pass in a TStream instead, and then write a custom TStream descendant that overwrites the virtual Write() method to append to the Memo, eg:

procedure GetDosOutput(Output: TStream; CommandLine: string; Work: string);
var
  ...
begin
  ...
  repeat
    WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
    if WasOK and (BytesRead > 0) then
      Output.WriteBuffer(Buffer, BytesRead);
  until (not WasOK) or (BytesRead = 0);
  ...
end;

type
  TMemoAppendStream = class(TStream)
  private
    FMemo: TMemo;
  public
    constructor Create(AMemo: TMemo);
    function Write(const Buffer; Count: Longint): Longint; override;
  end;

constructor TMemoAppendStream.Create(AMemo: TMemo);
begin
  inherited Create;
  FMemo := AMemo;
end;

function TMemoAppendStream.Write(const Buffer; Count: Longint): Longint;
var
  BufferStr: AnsiString;
begin
  Result := Count;
  SetString(BufferStr, PAnsiChar(@Buffer), Count);
  FMemo.SelStart := FMemo.GetTextLen;
  FMemo.SelLength := 0;
  FMemo.SelText := BufferStr;
end;

procedure TForm7.Button1Click(Sender: TObject);
var
  Strm: TMemoAppendStream;
begin
  Strm := TMemoAppendStream.Create(Memo1);
  try
    GetDosOutput(Strm, 'python mtk payload', ExtractFilePath(application.ExeName) + 'bin\');
  finally
    Strm.Free;
  end;
end;

 

thanks but its not working :( can you upload it with form thanks !

Edited February 5, 2022 by kvk1989

[qubits 20]

quick test, worked straight away with elegant changes recommened ..

no python, but gave me a dir listing..

 

 

ufrmMain.pas

[Remy Lebeau 1267]

On 2/4/2022 at 8:16 PM, kvk1989 said:

thanks but its not working :(

What exactly is not working?  Please be more specific.

On 2/4/2022 at 8:16 PM, kvk1989 said:

can you upload it with form

Actually, I can't.  I don't have to working IDE installed at the moment.  Everything I wrote earlier was from memory only.

[Fr0sT.Brutal 897]

On 2/4/2022 at 8:14 PM, Remy Lebeau said:

A better way to append text to the end of a Memo is to use its SelText property instead

Amazing option, I wasn't aware of that and messed with remembering whether there was CRLF at the end of text chunk.