Sunday, June 05, 2005

SendKeys routine for 32-bit Delphi

(* SendKeys routine for 32-bit Delphi.

Written by Ken Henderson

Copyright (c) 1995 Ken Henderson

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:


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):


Follow the keyname with a space and a number to send the specified key a given number of times (e.g., {left 6}). *)

unit SendKeys32;


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);


(* -- by Heri Setyono -- Sample : Sending key TAB when user press ENTER key, procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then SendKeys('{TAB}', False); end;

Sending key END when Edit Box got focus, procedure TForm1.Edit2Enter(Sender: TObject); begin SendKeys('{END}', False); end;

Sending key CTRL SHIFT END when Edit Box got focus, procedure TForm1.Edit2Enter(Sender: TObject); begin SendKeys('^+{END}', False); end; *)

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 {Unsigned -1}; 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; end else begin 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<L) do begin 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;


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,Integer(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;


No comments: