Консультации Портала - Консультация #179678

Задать вопрос Консультации Пользователи Форум

Задать вопрос экспертам

Консультация № 179678

07.08.2010, 19:31

0.00 руб.

0 13 1

Компьютеры Программирование

Здравствуйте Уважаемые эксперты. Подскажите пожалуйста, есть ли способ зная класс запущенной программы послать ей нажатие некоторых клавиш.
Например, чтобы в ней нажалась клавиша "T" или же "ENTER"...

Обсуждение

давно

Евгений/Genia007/

Профессионал
153662
1070

08.08.2010, 08:39

общий

Dimon4ik:
Например: Послать нажатие клавиш в программу Блокнот. Автор: http://www.swissdelphicenter.ch:

Код:

procedure TForm1.Button1Click(Sender: TObject);
 var
   wnd: HWND;
   i: Integer;
   s: string;
 begin
   wnd := FindWindow('notepad', nil);
   if wnd <> 0 then
   begin
     wnd := FindWindowEx(wnd, 0, 'Edit', nil);

     // Write Text in Notepad. 
    // Text ins Notepad schreiben. 
    s := 'Hello';
     for i := 1 to Length(s) do
       SendMessage(wnd, WM_CHAR, Word(s[i]), 0);
     // Simulate Return Key. 
    PostMessage(wnd, WM_KEYDOWN, VK_RETURN, 0);
     // Simulate Space. 
    PostMessage(wnd, WM_KEYDOWN, VK_SPACE, 0);
   end;
 end;


 // To send keys to Wordpad: 
  {...}
   wnd := FindWindow('WordPadClass', nil);

   if wnd <> 0 then
   begin
     wnd := FindWindowEx(wnd, 0, 'RICHEDIT', nil);
   {...}

или Компонент Sendkeys, который посылает нажатие клавиш в другие приложения. Автор: Gert v.d. Venis:

Код:

unit SendKeys;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TSendKeys = class(TComponent)
  private
    fhandle: HWND;
    L: Longint;
    fchild: boolean;
    fChildText: string;
    procedure SetIsChildWindow(const Value: boolean);
    procedure SetChildText(const Value: string);
    procedure SetWindowHandle(const Value: HWND);
  protected

  public

  published
    procedure GetWindowHandle(Text: string);
    procedure SendKeys(buffer: string);
    property WindowHandle: HWND read fhandle write SetWindowHandle;
    property IsChildWindow: boolean read fchild write SetIsChildWindow;
    property ChildWindowText: string read fChildText write SetChildText;
  end;

procedure Register;

implementation

var
  temps: string; {й utilizado para ser acessivel pelas funcs q sao
  utilizadas como callbacks}
  HTemp: Hwnd;
  ChildText: string;
  ChildWindow: boolean;

procedure Register;
begin
  RegisterComponents('Standard', [TSendKeys]);
end;

{ TSendKeys }

function PRVGetChildHandle(H: HWND; L: Integer): LongBool;
var
  p: pchar;
  I: integer;
  s: string;
begin
  I := length(ChildText) + 2;
  GetMem(p, i + 1);
  SendMessage(H, WM_GetText, i, integer(p));
  s := strpcopy(p, s);
  if pos(ChildText, s) <> 0 then
  begin
    HTemp := H;
    Result := False
  end
  else
    Result := True;
  FreeMem(p);
end;

function PRVSendKeys(H: HWND; L: Integer): LongBool; stdcall;
var
  s: string;
  i: integer;
begin
  i := length(temps);
  if i <> 0 then
  begin
    SetLength(s, i + 2);
    GetWindowText(H, pchar(s), i + 2);
    if Pos(temps, string(s)) <> 0 then
    begin
      Result := false;
      if ChildWindow then
        EnumChildWindows(H, @PRVGetChildHandle, L)
      else
        HTemp := H;
    end
    else
      Result := True;
  end
  else
    Result := False;
end;

procedure TSendKeys.GetWindowHandle(Text: string);
begin
  temps := Text;
  ChildText := fChildText;
  ChildWindow := fChild;
  EnumWindows(@PRVSendKeys, L);
  fHandle := HTemp;
end;

procedure TSendKeys.SendKeys(buffer: string);
var
  i: integer;
  w: word;
  D: DWORD;
  P: ^DWORD;
begin
  P := @D;
  SystemParametersInfo(//get flashing timeout on win98
    SPI_GETFOREGROUNDLOCKTIMEOUT,
    0,
    P,
    0);
  SetForeGroundWindow(fHandle);
  for i := 1 to length(buffer) do
  begin
    w := VkKeyScan(buffer[i]);
    keybd_event(w, 0, 0, 0);
    keybd_event(w, 0, KEYEVENTF_KEYUP, 0);
  end;
  SystemParametersInfo(//set flashing TimeOut=0
    SPI_SETFOREGROUNDLOCKTIMEOUT,
    0,
    nil,
    0);
  SetForegroundWindow(TWinControl(TComponent(Self).Owner).Handle);
  //->typecast working...
  SystemParametersInfo(//set flashing TimeOut=previous value
    SPI_SETFOREGROUNDLOCKTIMEOUT,
    D,
    nil,
    0);
end;

procedure TSendKeys.SetChildText(const Value: string);
begin
  fChildText := Value;
end;

procedure TSendKeys.SetIsChildWindow(const Value: boolean);
begin
  fchild := Value;
end;

procedure TSendKeys.SetWindowHandle(const Value: HWND);
begin
  fHandle := WindowHandle;
end;

end.

Описание:

Данный компонент получает хэндл(handle) любого запущенного окна и даёт возможность отправить по указанному хэндлу любые комбинации нажатия клавиш.

Совместимость: Все версии Delphi

Собственно сам исходничек:

После того, как проинсталируете этот компонент, создайте новое приложение и поместите на форму кнопку и сам компонент SendKeys. Добавьте следующий код в обработчик события OnClick кнопки:

Код:

procedure TForm1.Button1Click(Sender: TObject);
begin
  // Запускаем Notepad, и ему мы будем посылать нажатия клавиш
  WinExec('NotePad.exe', SW_SHOW);
  // В параметре процедуры GetWindowHandle помещаем
  // текст заголовка окна Notepad'а.
  SendKeys1.GetWindowHandle('Untitled - Notepad');
  // Если хэндл окна получен успешно, то отправляем ему текст
  if SendKeys1.WindowHandle <> 0 then
    SendKeys1.SendKeys('This is a test');
  // Так же можно отправить код любой кнопки типа
  // RETURN, используя следующий код:
  // SendKeys1.SendKeys(Chr(13));
end;

Взято с сайта Delphi World.

Об авторе:
Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru

Неизвестный

08.08.2010, 09:32

общий

Евгений/Genia007/:
Спасибо. Попробую и отпишусь

Неизвестный

09.08.2010, 15:57

общий

Добавил компонент SendKeys и создал переменную:
var
Form1: TForm1;
SendKeys1: TSendKeys ;
Но теперь при запуске в этой строчке:
ChildText := fChildText;
Возникает следующая ошибка:
Project Project2.exe raised exception dass EAccessViolation with message 'Access violation at address 0044D946 in module
'Project2.exe'. Read of address 0000003C'. Process stopped. Use Step or Run to continue.

давно

Евгений/Genia007/

Профессионал
153662
1070

10.08.2010, 11:40

общий

Dimon4ik:
Я сам не пробовал, похоже это обращение к несуществующему элементу, посмотрю.

Об авторе:
Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru

давно

Евгений/Genia007/

Профессионал
153662
1070

10.08.2010, 16:44

общий

Dimon4ik:
Пробовал на delphi7 вот исходник, работает без ошибок.

Об авторе:
Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru

Неизвестный

10.08.2010, 21:53

общий

Класс! Спасибо.
Проверю - отпишусь.

Неизвестный

11.08.2010, 12:08

общий

Попробовал - не получилась. Проблема следующая:
Зашел в папку "сам компонент". Запустил файл SendKeys1.dpk, скомпилировал и установил.
При открытии примера компилятор жалуется что файл ресурса не найден:

Но тем не менее при нажатии на "ОК" проект открывается, но при попытке компиляции он хочет установить что-то но не может найти:

При нажатии на отмену выдается следующее сообщение:

При нажатии на него компилятор вновь возвращается к редактированию кода. Тоесть не выходит скомпилировать.
Может установить компонент нужно как-то по другому...

давно

Евгений/Genia007/

Профессионал
153662
1070

11.08.2010, 18:16

общий

Dimon4ik:
SendKeys1.dpk я сделал сам в делфи(), наверное поэтому не заработал. Делал через меню установки нового компонента. Либо у Вас в делфи нет какогото файла, о чём и выдаётся окно, попробйте поставить диск с делфи и дать ему найти его.

Об авторе:
Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru

Неизвестный

11.08.2010, 18:38

общий

Ок. Сейчас попробую.

Неизвестный

11.08.2010, 19:51

общий

Спасибо! Работает!
А можно ли использовать данный компонент не по имени окна, а по классу окна?
И еще, если писать латинский символы или же символы коды которых представлены здесь:
URL >>
Ничего не проиходит...
То есть такая строка отработает:
SendKeys1.SendKeys('Привет!');
А такая нет:
SendKeys1.SendKeys('Hello!');
Или же такая тоже нет:
SendKeys1.SendKeys(Chr(84));

давно

Евгений/Genia007/

Профессионал
153662
1070

12.08.2010, 09:49

общий

Dimon4ik:
Я так думаю это зависит от раскладки клавиатуры. С временем на эксперименты туговато, вот нашёл ещё интересную статью:
Взаимодействие с чужими окнами
--------------------------------------------------------------------------------

Представьте себе, глупый пользователь сидит как ни в чём небывало с умным видом уже в какой раз пытается составить документ в Microsoft Word'e, но вдруг окно начинает бешено скакать по экрану, в его заголовке выводятся непристойные сообщения, оно то сворачивается, то разворачивается, меняя постоянно свои размеры, а под конец совсем исчезает, унося в небытиё весь текст, который с таким трудом набил ламерюга... а если так себя в любой момент может повести любая программа... впечатления от этого останутся на долго!!!

Для того, чтобы сделать что-нибудь над каким-либо окном нужно сначала получить его дескриптор, т.е. его положение в оперативной памяти. Для этого нужно использовать функцию FindWindow. Ей нужно указать всего два параметра: сначала класс искомого окна, затем его заголовок. Ну с заголовком проблем вообщем-то нет - его мы видим, но вот как определить класс... ведь он скрыт от глас пользователя. В действительности мы может указать только заголовок окна, а вместо класса ставим nil.

Для начала запустите стандартную программу "Блокнот" - и что же мы видим? В блокноте в заголовке окна отслеживается имя текущего файла. Изначально, т.к. файла нет в использовании, заголовок блокнота выглядит так: "Безымянный - Блокнот". Постараемся по этому критерию найти окно блокнота. Выглядеть это будет так:

if FindWindow(nil, 'Безымянный - Блокнот') <> 0 then
ShowMessage('Окно найдено')
else
ShowMessage('Окно НЕнайдено');

Как мы видим из кода, если наша программа найдёт окно блокнота, мы увидим сообщение, гласящее об этом.

Далее попробуем передвинуть это окно

var
h: HWND;
begin
h := findwindow(nil, 'Безымянный - Блокнот');
if h <> 0 then
SetWindowPos(h, HWND_BOTTOM, 1, 1, 20, 20, swp_nosize);
end;

Опять находим блокнот. Его дескриптор помещаем в переменную класса HWND[С английского Handle Window - дескриптор окна]. Далее используем функцию SetWindowPos для задания позиции. В качестве параметров нужно указать:

Дескриптор окна, которое хотим переместить
Идентификатор окна, которое предшествует перемещаемому окну в Z-последовательности. Z-последовательность это порядок, в котором формировались окна. Данный параметр указывает с какого именно окна необходимо начинать писк. В качестве значений может принимать либо дескриптор какого-либо окна в системе, либо одно из нижеследующих значений:
HWND_BOTTOM Начало Z-последовательности
HWND_NOTOPMOST Первое окно которое располагается не "поверх все окон"
HWND_TOP Вершина Z-последовательности
HWND_TOPMOST Первое окно которое располагается "поверх все окон"
Позиция окна по горизонтали
Позиция окна по вертикали
Ширина окна
Высота окна
Спецификаторы изменения позиции и размеров окна[флаги]. Для задания значения можно комбинировать следующие константы
SWP_DRAWFRAME Прорисовка фрейма вокруг окна.
SWP_FRAMECHANGED Посылает сообщение WM_NCCALCSIZE окну, даже если размер его не был изменён. Если этот флаг не указан, сообщение WM_NCCALCSIZE будет посылаться, только после изменения размеров окна.
SWP_HIDEWINDOW Скрывает окно.
SWP_NOACTIVATE Не активизирует окно. Если же этот флаг не будет поставлен, окно активизируется и будет перемещено поверх всех окон. А вот встанет ли окно даже выше тех окон, которым задано HWND_TOPMOST или нет зависит от параметра hWndInsertAfter.
SWP_NOCOPYBITS Если этот спецификатор не будет установлен, тогда содержимое клиентской области окна будет скопировано и вставлено во вновь отобразившееся окно после его перемещения.
SWP_NOMOVE Сообщает, что нужно игнорировать параметры задания позиции окну.
SWP_NOOWNERZORDER Сообщает, что не следует изменять позицию окна владельца в Z-последовательности.
SWP_NOREDRAW Не перерисовывает окно.
SWP_NOREPOSITION Такой же как и SWP_NOOWNERZORDER.
SWP_NOSENDCHANGING Мешает окну получить сообщение WM_WINDOWPOSCHANGING.
SWP_NOSIZE Сообщает, что нужно игнорировать параметры задания размеров окну.
SWP_NOZORDER Сохраняет текущее положение в Z-последовательности (игнорирует сообщение hWndInsertAfter parameter).
SWP_SHOWWINDOW Отображает окно.
Если данная функция выполнится успешно, она возвратит отличное от нуля значение. Ну, вот, теперь мы можем передвигать и изменять в размерах чужие окна!!! Для того, чтобы изменить заголовок окна напишем следующий код:

SetWindowText(FindWindow(nil, 'Безымянный - Блокнот'),
'Дарова, ламерюга, типа ты попал... ');

Функции setwindowtext нужно указать только два параметра: это дескриптор нужного окна и новое значение для заголовка. Вот вообщем-то и всё!

Есть ещё одна интересная функция ShowWindow, которая позволяет скрывать или отображать окна. Использовать её нужно так::

ShowWindow(FindWindow(nil, 'Безымянный - Блокнот'), sw_hide);

В скобках указываем сначала над каким именно окном хотим издеваться, а затем что именно мы хотим с ним сделать. В качестве возможных действий можем указать:

SW_HIDE Скрывает окно и активизирует другое.
SW_MAXIMIZE Разворачивает окно.
SW_MINIMIZE Сворачивает окно.
SW_RESTORE Активизирует и выводит окно. Если окно было развёрнуто или свёрнуто - восстанавливает исходный размер и позицию.
SW_SHOW Активизирует и выводит окно с его оригинальным размером и положением.
SW_SHOWDEFAULT Активизирует с установками, заданными в структуре STARTUPINFO, которая была передана при создании процесса приложением запускающим нужную программу.
SW_SHOWMAXIMIZED Выводит окно в развёрнутом виде.
SW_SHOWMINIMIZED Выводит окно в виде пиктограммы на панели задач.
SW_SHOWMINNOACTIVE Выводит окно в свёрнутом виде на панели задач и не передаёт ему фокус ввода, т.е. окно, которое до этого было активно остаётся активно по прежнему.
SW_SHOWNA Отображает окно в его текущем состоянии. Активное окно остаётся активным по прежнему.
SW_SHOWNOACTIVATE Выводит окно в его последнем положении и с последними используемыми размерами. Активное окно остаётся активным по прежнему.
SW_SHOWNORMAL Выводит окно. Если оно было свёрнуто или развёрнуто - восстанавливает его оригинальные размеры и позицию
Но вся сложность действий заключается в том, что в заголовке Блокнота отслеживается имя текущего файла и использовать значение "Безымянный - Блокнот" мы можем не всегда : (. Тем более это не только в случае с блокнотом... Но есть выход: ведь функции FindWindow для поиска окна мы указываем не только заголовок нужного окна, но ещё его класс. Какой же это выход скажете вы, заголовок окна мы видим, значит знаем, что указывать - а класс окна... в действительности тоже может найти приложив немного усилий!

В пакет Delphi входим специальная утилита для отслеживание всех активных процессов, она называется WinSight32. Вот ею мы и воспользуемся. Запустите её, покопайтесь в списке процессов, ищите строку где значится текущий заголовок нужного окна, например Блокнота, и в левой части этой строки в фигурных скобках вы найдёте имя класса окна. Для блокнота это будет "Notepad". Теперь зная имя класса окна мы можем переписать поиск окна таким способом:

ShowWindow(FindWindow('Notepad', nil), sw_hide);

Теперь мы вместо заголовка окна указываем значение nil, игнорируя данный параметр.

Есть ещё один замечательный способ передачи команд окнам.- функция PostMessage. Ей в качестве параметров нужно указать:

Дескриптор окна, которому посылается сообщение или следующие значения:
HWND_BROADCAST Сообщение будет послано всем окнам верхнего уровня системы, включая неактивные и невидимые окна, overlapped-окна, и PopUp-окна, но сообщение не будет посылаться дочерним[Child] окнам.
NULL Ведёт себя как функция PostThreadMessage с переданным ей dwThreadId параметром.
Посылаемое сообщение
Первый параметр сообщения
Второй параметр сообщения
Например, если послать сообщение wm_quit блокноту - окно будет закрыто без вывода всяких сообщений о необходимости сохранения!

PostMessage(FindWindow('Notepad', nil), wm_quit, 0, 0);

Об авторе:
Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru

Неизвестный

12.08.2010, 10:31

общий

Интересная статья. Здесь используются для поиска окна по классу стандартные функции Delphi.
А в SendKeys пользовательские с одним аргументом Text:String, в которых я не нашел как искать окно по его классу.
Видимо самому нужно разработать в по классу

Постараюсь изучить по лучше пример. Большое спасибо.
Оформите как ответ Ваш исходник с компонентом.

давно

Евгений/Genia007/

Профессионал
153662
1070

12.08.2010, 11:23

общий

это ответ

Здравствуйте, Dimon4ik.
Как вариант могу предложить компонент Sendkeys, который посылает нажатие клавиш в другие приложения. Автор: Gert v.d. Venis:

Код:

unit SendKeys;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TSendKeys = class(TComponent)
  private
    fhandle: HWND;
    L: Longint;
    fchild: boolean;
    fChildText: string;
    procedure SetIsChildWindow(const Value: boolean);
    procedure SetChildText(const Value: string);
    procedure SetWindowHandle(const Value: HWND);
  protected

  public

  published
    procedure GetWindowHandle(Text: string);
    procedure SendKeys(buffer: string);
    property WindowHandle: HWND read fhandle write SetWindowHandle;
    property IsChildWindow: boolean read fchild write SetIsChildWindow;
    property ChildWindowText: string read fChildText write SetChildText;
  end;

procedure Register;

implementation

var
  temps: string; {й utilizado para ser acessivel pelas funcs q sao
  utilizadas como callbacks}
  HTemp: Hwnd;
  ChildText: string;
  ChildWindow: boolean;

procedure Register;
begin
  RegisterComponents('Standard', [TSendKeys]);
end;

{ TSendKeys }

function PRVGetChildHandle(H: HWND; L: Integer): LongBool;
var
  p: pchar;
  I: integer;
  s: string;
begin
  I := length(ChildText) + 2;
  GetMem(p, i + 1);
  SendMessage(H, WM_GetText, i, integer(p));
  s := strpcopy(p, s);
  if pos(ChildText, s) <> 0 then
  begin
    HTemp := H;
    Result := False
  end
  else
    Result := True;
  FreeMem(p);
end;

function PRVSendKeys(H: HWND; L: Integer): LongBool; stdcall;
var
  s: string;
  i: integer;
begin
  i := length(temps);
  if i <> 0 then
  begin
    SetLength(s, i + 2);
    GetWindowText(H, pchar(s), i + 2);
    if Pos(temps, string(s)) <> 0 then
    begin
      Result := false;
      if ChildWindow then
        EnumChildWindows(H, @PRVGetChildHandle, L)
      else
        HTemp := H;
    end
    else
      Result := True;
  end
  else
    Result := False;
end;

procedure TSendKeys.GetWindowHandle(Text: string);
begin
  temps := Text;
  ChildText := fChildText;
  ChildWindow := fChild;
  EnumWindows(@PRVSendKeys, L);
  fHandle := HTemp;
end;

procedure TSendKeys.SendKeys(buffer: string);
var
  i: integer;
  w: word;
  D: DWORD;
  P: ^DWORD;
begin
  P := @D;
  SystemParametersInfo(//get flashing timeout on win98
    SPI_GETFOREGROUNDLOCKTIMEOUT,
    0,
    P,
    0);
  SetForeGroundWindow(fHandle);
  for i := 1 to length(buffer) do
  begin
    w := VkKeyScan(buffer[i]);
    keybd_event(w, 0, 0, 0);
    keybd_event(w, 0, KEYEVENTF_KEYUP, 0);
  end;
  SystemParametersInfo(//set flashing TimeOut=0
    SPI_SETFOREGROUNDLOCKTIMEOUT,
    0,
    nil,
    0);
  SetForegroundWindow(TWinControl(TComponent(Self).Owner).Handle);
  //->typecast working...
  SystemParametersInfo(//set flashing TimeOut=previous value
    SPI_SETFOREGROUNDLOCKTIMEOUT,
    D,
    nil,
    0);
end;

procedure TSendKeys.SetChildText(const Value: string);
begin
  fChildText := Value;
end;

procedure TSendKeys.SetIsChildWindow(const Value: boolean);
begin
  fchild := Value;
end;

procedure TSendKeys.SetWindowHandle(const Value: HWND);
begin
  fHandle := WindowHandle;
end;

end.

Код:

procedure TForm1.Button1Click(Sender: TObject);
begin
  // Запускаем Notepad, и ему мы будем посылать нажатия клавиш
  WinExec('NotePad.exe', SW_SHOW);
  // В параметре процедуры GetWindowHandle помещаем
  // текст заголовка окна Notepad'а.
  SendKeys1.GetWindowHandle('Untitled - Notepad');
  // Если хэндл окна получен успешно, то отправляем ему текст
  if SendKeys1.WindowHandle <> 0 then
    SendKeys1.SendKeys('This is a test');
  // Так же можно отправить код любой кнопки типа
  // RETURN, используя следующий код:
  // SendKeys1.SendKeys(Chr(13));
end;

Взято с сайта Delphi World. Архив с компонентом (сделан на deplhi7) и примером.

Большое спасибо за четкий, разверутый и очень полезный ответ. <br>

Об авторе:
Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru

Форма ответа

Отправка постов/ответов доступна только зарегистрированным и подтвержденным пользователям.

Если Вы уже зарегистрированы на Портале - войдите в систему, если Вы еще не регистрировались - пройдите простую процедуру регистрации.