Посылаем нажатия клавиш другому приложению

Delphi , ОС и Железо , Клавиши

Автор: Gert v.d. Venis
WEB-сайт: http://www.sources.ru

Компонент Sendkeys:

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 под названием TSendKeys, который позволяет отправлять клавиатурные команды в указанный обзорный номер окна. Компонент обеспечивает методы для установки обзорного номера окна, проверки работы с дочерним окном и отправки клавиатурных команд.

Вот разбивка кода:

1. Секция интерфейса определяет публичные и опубликованные разделы класса TSendKeys.
2. Приватная секция объявляет несколько переменных, включая fhandle, который хранит обзорный номер окна, L (который не используется), fchild, который указывает, работает ли компонент с дочерним окном, и fChildText, который хранит текст дочернего окна.
3. Защитная секция определяет метод для установки обзорного номера окна (SetWindowHandle) и процедуру для получения обзорного номера окна (GetWindowHandle).
4. Публичная секция определяет три процедуры:
   • SendKeys: отправляет клавиатурные команды в указанный обзорный номер окна.
   • GetWindowHandle: получает обзорный номер окна, соответствующий указанному тексту.
   • PRVSendKeys: это callback-функция, используемая SendKeys.
5. Секция реализации определяет несколько процедур и функций, включая:
   • PRVGetChildHandle: проверяет, работает ли компонент с дочерним окном.
   • PRVSendKeys: отправляет клавиатурные команды в указанный обзорный номер окна (callback-функция).
   • GetWindowHandle: получает обзорный номер окна, соответствующий указанному тексту.
   • SendKeys: отправляет клавиатурные команды в указанный обзорный номер окна.

Для использования этого компонента вы создадите экземпляр его на форме и затем вызовете методы в коде. Например, вы можете создать кнопку, которая вызывает метод GetWindowHandle с заголовком окна Notepad, а затем отправляет клавиатурные команды с помощью метода SendKeys.

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

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Клавиши ::