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

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

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

;

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

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

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com