[chuxlo]

Добрый день форумчане выручайте.Перехватываю вывод консоли.Все работает вывод перехватывается,но
консоль перестает реагировать на отсылаемые ей клавиатурные сообщения.При обычном запуске все нормально
консоль реагирует на клавиатурные сообщения.При запуске с перехватом указываю start.hStdInput := GetStdHandle(STD_INPUT_HANDLE) т.е не переназначать вход, так же приравнивал это значение нулю.
Все равно консоль перестает реагировать на сообщения клавиатуры.Куда копать?

[NumLock]

так если hStdInput перехватил, то на клавиатуру не будет реагировать. разве не так должно быть...

[chuxlo]

start.hStdInput := GetStdHandle(STD_INPUT_HANDLE) означает не перехватывать вход.

[NumLock]

а что GetStdHandle(STD_INPUT_HANDLE) не равно нулю??? глянь отладчиком.

[chuxlo]

GetStdHandle(STD_INPUT_HANDLE) приравнивал нулю увидел в одном из примеров-результат тот же вывод перехватывается, на ввод клавиатуры не реагирует.

[chuxlo]

GetStdHandle(STD_INPUT_HANDLE)=0 под отладчиком.

[NumLock]

ну вот видишь, а говоришь:

Сообщение от chuxlo

start.hStdInput := GetStdHandle(STD_INPUT_HANDLE) означает не перехватывать вход.

еще как перехватил, только непонятно куда. у меня вот так получилось через CONIN$
можно в консоли "dir" или "ver" написать и нажать Enter.

[chuxlo]

У тебя не консоль, а какой-то компонент на форме (Memo,Listbox...).
Скачай Mplayer.exe запусти через CreateProcess-это будет консоль.

[NumLock]

так форму сдвинь, консоль под ней. GUI только для отображения перехвата. ListBox там нет. да и на панели задач ее видно.

[chuxlo]

Извини действительно консоль под формой.Можешь предоставить исходный код?

[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.

[chuxlo]

NumLock.Огромное спасибо.Сейчас буду пробовать о результате отпишусь.

[chuxlo]

NumLock.Все что требовалось работает.100 лет жизни тебе.Кое что изменил.
Скрыл консоль и переделал отправку клавиатурных сообщений.Странно но твой метод по отправке не работает (Procedure WriteConsole).Может тебе
пригодится отправляю так:
h:=findWindow('ConsoleWindowClass',nil);
if h<>0 then begin
setforegroundwindow(h);// дает возможность отправлять, если окно свернуто
//или скрыто
SendMessage(h, WM_CHAR, Word('p'), 0);
end else showmessage('Окно не найдено.');
Это отправка символа 'p' -пауза.

[NumLock]

в моем примере отправка консоли работает. кнопка "send dir", например, работает в Windows 7 x32 и Windows 10 x64.

[chuxlo]

У меня стоит Windows xp и консолью запускаю Mplayer.exe.Главное способ
отправки ему сообщений клавиатуры найден.