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

Компонент 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
;

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

Другое по теме:

• Эмуляция нажатия клавиш
• Установка ловушки для клавиатуры
• Убрать программу из списка Ctrl+Alt+Delete