Програмная эмуляция нажатия клавиш

Code:

unit Unit1;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

Forms, Dialogs, StdCtrls;

type

TForm1 = class(TForm)

   Button1: TButton;

   Button2: TButton;

   procedure Button1Click(Sender: TObject);

   procedure Button2Click(Sender: TObject);

   procedure FormKeyPress(Sender: TObject; var Key: Char);

private

   AppInst: THandle;

   AppWind: THandle;

public

   { Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

uses ShellAPI;

procedure SendShift(H: HWnd; Down: Boolean);

var

vKey, ScanCode, wParam: Word;

lParam: longint;

begin

vKey := $10;

ScanCode := MapVirtualKey(vKey, 0);

wParam := vKey or ScanCode shl 8;

lParam := longint(ScanCode) shl 16 or 1;

if not (Down) then

   lParam := lParam or $C0000000;

SendMessage(H, WM_KEYDOWN, vKey, lParam);

end;

procedure SendCtrl(H: HWnd; Down: Boolean);

var

vKey, ScanCode, wParam: Word;

lParam: longint;

begin

vKey := $11;

ScanCode := MapVirtualKey(vKey, 0);

wParam := vKey or ScanCode shl 8;

lParam := longint(ScanCode) shl 16 or 1;

if not (Down) then

   lParam := lParam or $C0000000;

SendMessage(H, WM_KEYDOWN, vKey, lParam);

end;

procedure SendKey(H: Hwnd; Key: char);

var

vKey, ScanCode, wParam: Word;

lParam, ConvKey: longint;

Shift, Ctrl: boolean;

begin

ConvKey := OemKeyScan(ord(Key));

Shift := (ConvKey and $00020000) <> 0;

Ctrl := (ConvKey and $00040000) <> 0;

ScanCode := ConvKey and $000000FF or $FF00;

vKey := ord(Key);

wParam := vKey;

lParam := longint(ScanCode) shl 16 or 1;

if Shift then

   SendShift(H, true);

if Ctrl then

   SendCtrl(H, true);

SendMessage(H, WM_KEYDOWN, vKey, lParam);

SendMessage(H, WM_CHAR, vKey, lParam);

lParam := lParam or $C0000000;

SendMessage(H, WM_KEYUP, vKey, lParam);

if Shift then

   SendShift(H, false);

if Ctrl then

   SendCtrl(H, false);

end;

function EnumFunc(Handle: HWnd; TF: TForm1): Bool; far;

begin

TF.AppWind := 0;

if GetWindowWord(Handle, GWW_HINSTANCE) = TF.AppInst then

   TF.AppWind := Handle;

result := (TF.AppWind = 0);

end;

procedure TForm1.Button1Click(Sender: TObject);

var

Text: array[0..255] of char;

begin

AppInst := ShellExecute(Handle, 'open', 'notepad.exe', nil, '', SW_NORMAL);

EnumWindows(@EnumFunc, longint(self));

AppWind := GetWindow(AppWind, GW_CHILD);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

SendKey(AppWind, 'T');

SendKey(AppWind, 'e');

SendKey(AppWind, 's');

SendKey(AppWind, 't');

end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);

begin

if AppWind <> 0 then

   SendKey(AppWind, Key);

end;

end.