Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

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

01.01.2007

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

https://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_Next
, {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, Top, Middle : Byte;
begin
 
Result:=INVALIDKEY;
 
Bottom:=1;
 
Top:=MaxSendKeyRecs;
 
Found:=false;
 
Middle:=(Bottom+Top) div 2;
 
Repeat
   
Collided:=((Bottom=Middle) or (Top=Middle));
   
if (KeyString=SendKeyRecs[Middle].Name) then begin
       
Found:=true;
       
Result:=SendKeyRecs[Middle].VKey;
           
if (KeyString>SendKeyRecs[Middle].Name) then Bottom:=Middle
       
else Top:=Middle;
       
Middle:=(Succ(Bottom+Top)) 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.

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