[NumLock]

код очень сырой, чисто для эксперимента. хэндлы не закрываются, для чтения вместо потока используется таймер для Delphi 2010

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    hPipeOutputRead: THandle;
    hPipeOutputWrite: THandle;
    StartupInfo: TStartupInfoA;
    procedure WriteConsole(c: AnsiChar);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WriteConsole(c: AnsiChar);
var
  NumberOfEventsWritten: DWORD;
  InputRecord: array [1..1] of TInputRecord;
begin
  InputRecord[1].EventType:=KEY_EVENT;
  InputRecord[1].Event.KeyEvent.bKeyDown:=True;
  InputRecord[1].Event.KeyEvent.wRepeatCount:=1;
  InputRecord[1].Event.KeyEvent.wVirtualKeyCode:=0;
  InputRecord[1].Event.KeyEvent.wVirtualScanCode:=0;
  InputRecord[1].Event.KeyEvent.AsciiChar:=c;
  InputRecord[1].Event.KeyEvent.dwControlKeyState:=0;
  if not WriteConsoleInput(StartupInfo.hStdInput,
    InputRecord[1], 1, NumberOfEventsWritten) then RaiseLastOSError;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  WriteConsole('d');
  WriteConsole('i');
  WriteConsole('r');
  WriteConsole(#13);
  WriteConsole(#10);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  WriteConsole('e');
  WriteConsole('x');
  WriteConsole('i');
  WriteConsole('t');
  WriteConsole(#13);
  WriteConsole(#10);
  FreeConsole;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  SecurityAttributes: TSecurityAttributes;
  ProcessInformation: TProcessInformation;
begin
  AllocConsole;

  SecurityAttributes.nLength:=SizeOf(TSecurityAttributes);
  SecurityAttributes.lpSecurityDescriptor:=nil;
  SecurityAttributes.bInheritHandle:=True;

  CreatePipe(hPipeOutputRead, hPipeOutputWrite, @SecurityAttributes, 0);

  ZeroMemory(@StartupInfo, SizeOf(TStartupInfoA));
  StartupInfo.cb:=SizeOf(TStartupInfoA);
  StartupInfo.wShowWindow:=SW_SHOWNORMAL;
  StartupInfo.hStdInput:=CreateFile('CONIN$', GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ,
    @SecurityAttributes, OPEN_EXISTING, 0, 0);
  if StartupInfo.hStdInput=INVALID_HANDLE_VALUE then RaiseLastOSError;
  StartupInfo.hStdOutput:=hPipeOutputWrite;
  StartupInfo.hStdError:=hPipeOutputWrite;
  StartupInfo.dwFlags:=STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
  if not CreateProcessA(nil,
    PAnsiChar('cmd'),
    nil,
    nil,
    True,
    0,
    nil,
    nil,
    StartupInfo,
    ProcessInformation) then RaiseLastOSError;

  Timer1.Enabled:=True;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Buffer: array [0..$fff] of AnsiChar;
  BufferTo: array [0..$fff] of AnsiChar;
  NumberOfBytesRead: DWORD;
begin
  if GetFileSize(hPipeOutputRead, nil)=0 then Exit;
  if ReadFile(hPipeOutputRead, Buffer[0], Length(Buffer), NumberOfBytesRead, nil) then
  begin
    OemToCharBuffA(@Buffer[0], @BufferTo[0], NumberOfBytesRead);
    Memo1.Lines.Add(Copy(string(PAnsiChar(@BufferTo[0])), 1, NumberOfBytesRead));
  end;
end;

end.