Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > ОС и железо
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 26.01.2016, 18:27
chuxlo chuxlo вне форума
Прохожий
 
Регистрация: 22.02.2015
Сообщения: 13
Версия Delphi: Delphi4
Репутация: 10
По умолчанию Перехват консольного вывода

Добрый день форумчане выручайте.Перехватываю вывод консоли.Все работает вывод перехватывается,но
консоль перестает реагировать на отсылаемые ей клавиатурные сообщения.При обычном запуске все нормально
консоль реагирует на клавиатурные сообщения.При запуске с перехватом указываю start.hStdInput := GetStdHandle(STD_INPUT_HANDLE) т.е не переназначать вход, так же приравнивал это значение нулю.
Все равно консоль перестает реагировать на сообщения клавиатуры.Куда копать?
Ответить с цитированием
  #2  
Старый 26.01.2016, 18:39
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

так если hStdInput перехватил, то на клавиатуру не будет реагировать. разве не так должно быть...
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #3  
Старый 26.01.2016, 18:43
chuxlo chuxlo вне форума
Прохожий
 
Регистрация: 22.02.2015
Сообщения: 13
Версия Delphi: Delphi4
Репутация: 10
По умолчанию

start.hStdInput := GetStdHandle(STD_INPUT_HANDLE) означает не перехватывать вход.
Ответить с цитированием
  #4  
Старый 27.01.2016, 11:49
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

а что GetStdHandle(STD_INPUT_HANDLE) не равно нулю??? глянь отладчиком.
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #5  
Старый 27.01.2016, 15:32
chuxlo chuxlo вне форума
Прохожий
 
Регистрация: 22.02.2015
Сообщения: 13
Версия Delphi: Delphi4
Репутация: 10
По умолчанию

GetStdHandle(STD_INPUT_HANDLE) приравнивал нулю увидел в одном из примеров-результат тот же вывод перехватывается, на ввод клавиатуры не реагирует.
Ответить с цитированием
  #6  
Старый 27.01.2016, 15:37
chuxlo chuxlo вне форума
Прохожий
 
Регистрация: 22.02.2015
Сообщения: 13
Версия Delphi: Delphi4
Репутация: 10
По умолчанию

GetStdHandle(STD_INPUT_HANDLE)=0 под отладчиком.
Ответить с цитированием
  #7  
Старый 27.01.2016, 15:42
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

ну вот видишь, а говоришь:
Цитата:
Сообщение от chuxlo
start.hStdInput := GetStdHandle(STD_INPUT_HANDLE) означает не перехватывать вход.
еще как перехватил, только непонятно куда. у меня вот так получилось через CONIN$
можно в консоли "dir" или "ver" написать и нажать Enter.
Вложения
Тип файла: zip Project1.zip (375.3 Кбайт, 11 просмотров)
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #8  
Старый 27.01.2016, 16:00
chuxlo chuxlo вне форума
Прохожий
 
Регистрация: 22.02.2015
Сообщения: 13
Версия Delphi: Delphi4
Репутация: 10
По умолчанию

У тебя не консоль, а какой-то компонент на форме (Memo,Listbox...).
Скачай Mplayer.exe запусти через CreateProcess-это будет консоль.
Ответить с цитированием
  #9  
Старый 27.01.2016, 16:15
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

так форму сдвинь, консоль под ней. GUI только для отображения перехвата. ListBox там нет. да и на панели задач ее видно.
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #10  
Старый 27.01.2016, 16:42
chuxlo chuxlo вне форума
Прохожий
 
Регистрация: 22.02.2015
Сообщения: 13
Версия Delphi: Delphi4
Репутация: 10
По умолчанию

Извини действительно консоль под формой.Можешь предоставить исходный код?
Ответить с цитированием
  #11  
Старый 28.01.2016, 07:53
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

код очень сырой, чисто для эксперимента. хэндлы не закрываются, для чтения вместо потока используется таймер для 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.
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #12  
Старый 28.01.2016, 15:22
chuxlo chuxlo вне форума
Прохожий
 
Регистрация: 22.02.2015
Сообщения: 13
Версия Delphi: Delphi4
Репутация: 10
По умолчанию

NumLock.Огромное спасибо.Сейчас буду пробовать о результате отпишусь.
Ответить с цитированием
  #13  
Старый 28.01.2016, 16:33
chuxlo chuxlo вне форума
Прохожий
 
Регистрация: 22.02.2015
Сообщения: 13
Версия Delphi: Delphi4
Репутация: 10
По умолчанию

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' -пауза.
Ответить с цитированием
  #14  
Старый 28.01.2016, 17:59
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

в моем примере отправка консоли работает. кнопка "send dir", например, работает в Windows 7 x32 и Windows 10 x64.
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #15  
Старый 28.01.2016, 18:12
chuxlo chuxlo вне форума
Прохожий
 
Регистрация: 22.02.2015
Сообщения: 13
Версия Delphi: Delphi4
Репутация: 10
По умолчанию

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


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 03:55.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter