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

Автор: Gert v.d. Venis

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

---------------------------------

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

Взято с Исходников.ru




Содержание раздела

---

---