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

Материал из DRKB

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

Компонент 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; { для функций обратного вызова }
  HTemp: Hwnd;
  ChildText: string;
  ChildWindow: Boolean;

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

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;

{ TSendKeys }

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;


Неправда ли весело :)


Author: Gert v.d. Venis
Source: Взято из http://forum.sources.ru
ID: 02085