Как эмулировать нажатия клавиш в другой программе?

Как эмулировать нажатия клавиш в другой программе
http://delfaq.wallst.ru/faq/emul.html
Этот модуль является почти полным аналогом мотоду SendKeys из VB.
(Автор: Ken Henderson, email:khen@compuserve.com)

{

SendKeys routine for 32-bit Delphi.

Written by Ken Henderson

Copyright (c) 1995 Ken Henderson email:khen@compuserve.com

This unit includes two routines that simulate popular Visual Basic

routines: Sendkeys and AppActivate. SendKeys takes a PChar

as its first parameter and a boolean as its second, like so:

SendKeys('KeyString', Wait);

where KeyString is a string of key names and modifiers that you want

to send to the current input focus and Wait is a boolean variable or value

that indicates whether SendKeys should wait for each key message to be

processed before proceeding. See the table below for more information.

AppActivate also takes a PChar as its only parameter, like so:

AppActivate('WindowName');

where WindowName is the name of the window that you want to make the

current input focus.

SendKeys supports the Visual Basic SendKeys syntax, as documented below.

Supported modifiers:

+ = Shift

^ = Control

% = Alt

Surround sequences of characters or key names with parentheses in order to

modify them as a group. For example, '+abc' shifts only 'a', while '+(abc)' shifts

all three characters.

Supported special characters

~ = Enter

( = Begin modifier group (see above)

) = End modifier group (see above)

{ = Begin key name text (see below)

}
= End key name text (see below)

Supported characters:

Any character that can be typed is supported. Surround the modifier keys

listed above with braces in order to send as normal text.

Supported key names (surround these with braces):

BKSP, BS, BACKSPACE

BREAK

CAPSLOCK

CLEAR

DEL

DELETE

DOWN

END

ENTER

ESC

ESCAPE

F1

F2

F3

F4

F5

F6

F7

F8

F9

F10

F11

F12

F13

F14

F15

F16

HELP

HOME

INS

LEFT

NUMLOCK

PGDN

PGUP

PRTSC

RIGHT

SCROLLLOCK

TAB

UP

Follow the keyname with a space and a number to send the specified key a

given number of times (e.g., {left 6}).

}

unit sndkey32;

interface

Uses SysUtils, Windows, Messages;

function SendKeys(SendKeysString : PChar; Wait : Boolean) : Boolean;

function AppActivate(WindowName : PChar) : boolean;



{Buffer for working with PChar's}



const

 WorkBufLen = 40;

var

 WorkBuf : array[0..WorkBufLen] of Char;

implementation

type

 THKeys = array[0..pred(MaxLongInt)] of byte;

var

 AllocationSize : integer;



(*

Converts a string of characters and key names to keyboard events and

passes them to Windows.

Example syntax:

SendKeys('abc123{left}{left}{left}def{end}456{left 6}ghi{end}789', True);

*)




function SendKeys(SendKeysString : PChar; Wait : Boolean) : Boolean;

type

 WBytes = array[0..pred(SizeOf(Word))] of Byte;

 TSendKey = record

  Name : ShortString;

  VKey : Byte;

 end;

const

{Array of keys that SendKeys recognizes.

 if you add to this list, you must be sure to keep it sorted alphabetically

 by Name because a binary search routine is used to scan it.}




 MaxSendKeyRecs = 41;

 SendKeyRecs : array[1..MaxSendKeyRecs] of TSendKey =

 (

  (Name:'BKSP'; VKey:VK_BACK),

  (Name:'BS'; VKey:VK_BACK),

  (Name:'BACKSPACE'; VKey:VK_BACK),

  (Name:'BREAK'; VKey:VK_CANCEL),

  (Name:'CAPSLOCK'; VKey:VK_CAPITAL),

  (Name:'CLEAR'; VKey:VK_CLEAR),

  (Name:'DEL'; VKey:VK_DELETE),

  (Name:'DELETE'; VKey:VK_DELETE),

  (Name:'DOWN'; VKey:VK_DOWN),

  (Name:'END'; VKey:VK_END),

  (Name:'ENTER'; VKey:VK_RETURN),

  (Name:'ESC'; VKey:VK_ESCAPE),

  (Name:'ESCAPE'; VKey:VK_ESCAPE),

  (Name:'F1'; VKey:VK_F1),

  (Name:'F10'; VKey:VK_F10),

  (Name:'F11'; VKey:VK_F11),

  (Name:'F12'; VKey:VK_F12),

  (Name:'F13'; VKey:VK_F13),

  (Name:'F14'; VKey:VK_F14),

  (Name:'F15'; VKey:VK_F15),

  (Name:'F16'; VKey:VK_F16),

  (Name:'F2'; VKey:VK_F2),

  (Name:'F3'; VKey:VK_F3),

  (Name:'F4'; VKey:VK_F4),

  (Name:'F5'; VKey:VK_F5),

  (Name:'F6'; VKey:VK_F6),

  (Name:'F7'; VKey:VK_F7),

  (Name:'F8'; VKey:VK_F8),

  (Name:'F9'; VKey:VK_F9),

  (Name:'HELP'; VKey:VK_HELP),

  (Name:'HOME'; VKey:VK_HOME),

  (Name:'INS'; VKey:VK_INSERT),

  (Name:'LEFT'; VKey:VK_LEFT),

  (Name:'NUMLOCK'; VKey:VK_NUMLOCK),

  (Name:'PGDN'; VKey:VK_NEXT),

  (Name:'PGUP'; VKey:VK_PRIOR),

  (Name:'PRTSC'; VKey:VK_PRINT),

  (Name:'RIGHT'; VKey:VK_RIGHT),

  (Name:'SCROLLLOCK'; VKey:VK_SCROLL),

  (Name:'TAB'; VKey:VK_TAB),

  (Name:'UP'; VKey:VK_UP)

 );

{Extra VK constants missing from Delphi's Windows API interface}

 VK_NULL=0;

 VK_SemiColon=186;

 VK_Equal=187;

 VK_Comma=188;

 VK_Minus=189;

 VK_Period=190;

 VK_Slash=191;

 VK_BackQuote=192;

 VK_LeftBracket=219;

 VK_BackSlash=220;

 VK_RightBracket=221;

 VK_Quote=222;

 VK_Last=VK_Quote;

 ExtendedVKeys : set of byte =

 [VK_Up,

  VK_Down,

  VK_Left,

  VK_Right,

  VK_Home,

  VK_End,

  VK_Prior, {PgUp}

  VK_, {PgDn}

  VK_Insert,

  VK_Delete];

const

 INVALIDKEY = $FFFF;

 VKKEYSCANSHIFTON = $01;

 VKKEYSCANCTRLON = $02;

 VKKEYSCANALTON = $04;

 UNITNAME = 'SendKeys';

var

 UsingParens, ShiftDown, ControlDown, AltDown, FoundClose : Boolean;

 PosSpace : Byte;

 I, L : Integer;

 NumTimes, MKey : Word;

 KeyString : String[20];

procedure DisplayMessage(Message : PChar);

begin

 MessageBox(0,Message,UNITNAME,0);

end;

function BitSet(BitTable, BitMask : Byte) : Boolean;

begin

 Result:=ByteBool(BitTable and BitMask);

end;

procedure SetBit(var BitTable : Byte; BitMask : Byte);

begin

 BitTable:=BitTable or Bitmask;

end;

procedure KeyboardEvent(VKey, ScanCode : Byte; Flags : Longint);

var

 KeyboardMsg : TMsg;

begin

 keybd_event(VKey, ScanCode, Flags,0);

 if (Wait) then While (PeekMessage(KeyboardMsg,0,WM_KEYFIRST, WM_KEYLAST, PM_REMOVE)) do begin

  TranslateMessage(KeyboardMsg);

  DispatchMessage(KeyboardMsg);

 end;

end;

procedure SendKeyDown(VKey: Byte; NumTimes : Word; GenUpMsg : Boolean);

var

 Cnt : Word;

 ScanCode : Byte;

 NumState : Boolean;

 KeyBoardState : TKeyboardState;

begin

 if (VKey=VK_NUMLOCK) then begin

  NumState:=ByteBool(GetKeyState(VK_NUMLOCK) and 1);

  GetKeyBoardState(KeyBoardState);

  if NumState then KeyBoardState[VK_NUMLOCK]:=(KeyBoardState[VK_NUMLOCK] and not 1)

  else KeyBoardState[VK_NUMLOCK]:=(KeyBoardState[VK_NUMLOCK] or 1);

  SetKeyBoardState(KeyBoardState);

  exit;

 end;

 ScanCode:=Lo(MapVirtualKey(VKey,0));

 For Cnt:=1 to NumTimes do

  if (VKey in ExtendedVKeys)then begin

  KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY);

  if (GenUpMsg) then

  KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP)

  end else begin

  KeyboardEvent(VKey, ScanCode, 0);

  if (GenUpMsg) then KeyboardEvent(VKey, ScanCode, KEYEVENTF_KEYUP);

  end;

end;

procedure SendKeyUp(VKey: Byte);

var

 ScanCode : Byte;

begin

 ScanCode:=Lo(MapVirtualKey(VKey,0));

 if (VKey in ExtendedVKeys)then

  KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY and KEYEVENTF_KEYUP)

 else KeyboardEvent(VKey, ScanCode, KEYEVENTF_KEYUP);

end;

procedure SendKey(MKey: Word; NumTimes : Word; GenDownMsg : Boolean);

begin

 if (BitSet(Hi(MKey),VKKEYSCANSHIFTON)) then SendKeyDown(VK_SHIFT,1,False);

 if (BitSet(Hi(MKey),VKKEYSCANCTRLON)) then SendKeyDown(VK_CONTROL,1,False);

 if (BitSet(Hi(MKey),VKKEYSCANALTON)) then SendKeyDown(VK_MENU,1,False);

 SendKeyDown(Lo(MKey), NumTimes, GenDownMsg);

 if (BitSet(Hi(MKey),VKKEYSCANSHIFTON)) then SendKeyUp(VK_SHIFT);

 if (BitSet(Hi(MKey),VKKEYSCANCTRLON)) then SendKeyUp(VK_CONTROL);

 if (BitSet(Hi(MKey),VKKEYSCANALTON)) then SendKeyUp(VK_MENU);

end;

{Implements a simple binary search to locate special key name strings}

function StringToVKey(KeyString : ShortString) : Word;

var

 Found, Collided : Boolean;

 Bottom, , Middle : Byte;

begin

 Result:=INVALIDKEY;

 Bottom:=1;

 :=MaxSendKeyRecs;

 Found:=false;

 Middle:=(Bottom+) div 2;

 Repeat

  Collided:=((Bottom=Middle) or (=Middle));

  if (KeyString=SendKeyRecs[Middle].Name) then begin

  Found:=true;

  Result:=SendKeyRecs[Middle].VKey;

  if (KeyString>SendKeyRecs[Middle].Name) then Bottom:=Middle

  else :=Middle;

  Middle:=(Succ(Bottom+)) div 2;

  end;

 Until (Found or Collided);

 if (Result=INVALIDKEY) then DisplayMessage('Invalid Key Name');

end;

procedure PopUpShiftKeys;

begin

 if (not UsingParens) then begin

  if ShiftDown then SendKeyUp(VK_SHIFT);

  if ControlDown then SendKeyUp(VK_CONTROL);

  if AltDown then SendKeyUp(VK_MENU);

  ShiftDown:=false;

  ControlDown:=false;

  AltDown:=false;

 end;

end;

begin

 AllocationSize:=MaxInt;

 Result:=false;

 UsingParens:=false;

 ShiftDown:=false;

 ControlDown:=false;

 AltDown:=false;

 I:=0;

 L:=StrLen(SendKeysString);

 if (L>AllocationSize) then L:=AllocationSize;

 if (L=0) then Exit;

 While (I

  case SendKeysString[I] of

  '(' : begin

  UsingParens:=true;

  Inc(I);

  end;

  ')' : begin

  UsingParens:=false;

  PopUpShiftKeys;

  Inc(I); end;

  '%' : begin

  AltDown:=true;

  SendKeyDown(VK_MENU,1,False);

  Inc(I);

  end;

  '+' : begin

  ShiftDown:=true;

  SendKeyDown(VK_SHIFT,1,False);

  Inc(I);

  end;

  '^' : begin

  ControlDown:=true;

  SendKeyDown(VK_CONTROL,1,False);

  Inc(I);

  end;

  '{' : begin

  NumTimes:=1;

  if (SendKeysString[Succ(I)]='{') then begin

  MKey:=VK_LEFTBRACKET;

  SetBit(Wbytes(MKey)[1],VKKEYSCANSHIFTON);

  SendKey(MKey,1,True);

  PopUpShiftKeys;

  Inc(I,3);

  Continue;

  end;

  KeyString:='';

  FoundClose:=false;

  While (I<=L) do begin

  Inc(I);

  if (SendKeysString[I]='}') then begin

  FoundClose:=true;

  Inc(I);

  Break;

  end;

  KeyString:=KeyString+Upcase(SendKeysString[I]);

  end;

  if (Not FoundClose) then begin

  DisplayMessage('No Close');

  Exit;

  end;

  if (SendKeysString[I]='}') then begin

  MKey:=VK_RIGHTBRACKET;

  SetBit(Wbytes(MKey)[1],VKKEYSCANSHIFTON);

  SendKey(MKey,1,True);

  PopUpShiftKeys;

  Inc(I);

  Continue;

  end;

  PosSpace:=Pos(' ',KeyString);

  if (PosSpace<>0) then begin

  NumTimes:=StrToInt(Copy(KeyString,Succ(PosSpace),Length(KeyString)-PosSpace));

  KeyString:=Copy(KeyString,1,Pred(PosSpace));

  end;

  if (Length(KeyString)=1) then MKey:=vkKeyScan(KeyString[1])

  else MKey:=StringToVKey(KeyString);

  if (MKey<>INVALIDKEY) then begin

  SendKey(MKey,NumTimes,True);

  PopUpShiftKeys;

  Continue;

  end;

  end;

  '~' : begin

  SendKeyDown(VK_RETURN,1,True);

  PopUpShiftKeys;

  Inc(I);

  end;

  else begin

  MKey:=vkKeyScan(SendKeysString[I]);

  if (MKey<>INVALIDKEY) then begin

  SendKey(MKey,1,True);

  PopUpShiftKeys;

  end else DisplayMessage('Invalid KeyName');

  Inc(I);

  end;

  end;

 end;

 Result:=true;

 PopUpShiftKeys;

end;

{AppActivate

This is used to set the current input focus to a given window using its

name. This is especially useful for ensuring a window is active before

sending it input messages using the SendKeys function. You can specify

a window's name in its entirety, or only portion of it, beginning from

the left.

}


var

 WindowHandle : HWND;

function EnumWindowsProc(WHandle: HWND; lParam: LPARAM): BOOL; export; stdcall;

const

 MAX_WINDOW_NAME_LEN = 80;

var

 WindowName : array[0..MAX_WINDOW_NAME_LEN] of char;

begin

 {Can't test GetWindowText's return value since some windows don't have a title}

 GetWindowText(WHandle,WindowName,MAX_WINDOW_NAME_LEN);

 Result := (StrLIComp(WindowName,PChar(lParam), StrLen(PChar(lParam))) <> 0);

 if (not Result) then WindowHandle:=WHandle;

end;

function AppActivate(WindowName : PChar) : boolean;

begin

 try

  Result:=true;

  WindowHandle:=FindWindow(nil,WindowName);

  if (WindowHandle=0) then EnumWindows(@EnumWindowsProc,Intege (PChar(WindowName)));

  if (WindowHandle<>0) then begin

  SendMessage(WindowHandle, WM_SYSCOMMAND, SC_HOTKEY, WindowHandle);

  SendMessage(WindowHandle, WM_SYSCOMMAND, SC_RESTORE, WindowHandle);

  end else Result:=false;

 except

  on Exception do Result:=false;

 end;

end;

end.

Взято с сайта http://blackman.wp-club.net/

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...