Skip to content

Instantly share code, notes, and snippets.

@jarroddavis68
Last active April 21, 2022 06:50
Show Gist options
  • Select an option

  • Save jarroddavis68/c5ecbffce4944a9b55e3b54d067f696a to your computer and use it in GitHub Desktop.

Select an option

Save jarroddavis68/c5ecbffce4944a9b55e3b54d067f696a to your computer and use it in GitHub Desktop.

Revisions

  1. jarroddavis68 revised this gist Apr 19, 2022. 1 changed file with 1 addition and 0 deletions.
    1 change: 1 addition & 0 deletions uCaptureConsoleEvent.pas
    Original file line number Diff line number Diff line change
    @@ -14,6 +14,7 @@ implementation
    uses
    System.SysUtils,
    System.Classes,
    VCL.Forms,
    WinAPI.Windows;

    procedure CaptureConsoleOutput(const aTitle: string; const aCommand: PChar; const aParameters: PChar; aSender: Pointer; aEvent: TCaptureConsoleEvent);
  2. jarroddavis68 renamed this gist Apr 19, 2022. 1 changed file with 0 additions and 0 deletions.
    File renamed without changes.
  3. jarroddavis68 created this gist Apr 19, 2022.
    94 changes: 94 additions & 0 deletions CaptureConsoleEvent.pas
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,94 @@
    unit uCaptureConsoleEvent;

    interface

    type

    { TCaptureConsoleEvent }
    TCaptureConsoleEvent = procedure(aSender: Pointer; aLine: string);

    procedure CaptureConsoleOutput(const aTitle: string; const aCommand: PChar; const aParameters: PChar; aSender: Pointer; aEvent: TCaptureConsoleEvent);

    implementation

    uses
    System.SysUtils,
    System.Classes,
    WinAPI.Windows;

    procedure CaptureConsoleOutput(const aTitle: string; const aCommand: PChar; const aParameters: PChar; aSender: Pointer; aEvent: TCaptureConsoleEvent);
    const
    CReadBuffer = 2400;
    var
    saSecurity: TSecurityAttributes;
    hRead: THandle;
    hWrite: THandle;
    suiStartup: TStartupInfo;
    piProcess: TProcessInformation;
    pBuffer: array [0 .. CReadBuffer] of AnsiChar;
    dBuffer: array [0 .. CReadBuffer] of AnsiChar;
    dRead: DWORD;
    dRunning: DWORD;
    dAvailable: DWORD;
    CmdLine: string;
    BufferList: TStringList;
    Line: string;
    begin
    saSecurity.nLength := SizeOf(TSecurityAttributes);
    saSecurity.bInheritHandle := true;
    saSecurity.lpSecurityDescriptor := nil;
    if CreatePipe(hRead, hWrite, @saSecurity, 0) then
    try
    FillChar(suiStartup, SizeOf(TStartupInfo), #0);
    suiStartup.cb := SizeOf(TStartupInfo);
    suiStartup.hStdInput := hRead;
    suiStartup.hStdOutput := hWrite;
    suiStartup.hStdError := hWrite;
    suiStartup.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
    suiStartup.wShowWindow := SW_HIDE;
    if aTitle.IsEmpty then
    suiStartup.lpTitle := nil
    else
    suiStartup.lpTitle := PChar(aTitle);
    CmdLine := aCommand + ' ' + aParameters;
    if CreateProcess(nil, PChar(CmdLine), @saSecurity, @saSecurity, true, NORMAL_PRIORITY_CLASS, nil, nil, suiStartup, piProcess) then
    try
    BufferList := TStringList.Create;
    try
    repeat
    dRunning := WaitForSingleObject(piProcess.hProcess, 100);
    PeekNamedPipe(hRead, nil, 0, nil, @dAvailable, nil);
    if (dAvailable > 0) then
    repeat
    dRead := 0;
    ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, nil);
    pBuffer[dRead] := #0;
    OemToCharA(pBuffer, dBuffer);
    BufferList.Clear;
    BufferList.Text := string(pBuffer);
    for line in BufferList do
    begin
    if Assigned(aEvent) then
    begin
    aEvent(aSender, line);
    end;
    end;
    until (dRead < CReadBuffer);
    Application.ProcessMessages;
    until (dRunning <> WAIT_TIMEOUT);
    finally
    FreeAndNil(BufferList);
    end;
    finally
    CloseHandle(piProcess.hProcess);
    CloseHandle(piProcess.hThread);
    end;
    finally
    CloseHandle(hRead);
    CloseHandle(hWrite);
    end;
    end;

    end.