home *** CD-ROM | disk | FTP | other *** search
/ PC World Plus! (NZ) 2001 June / HDC50.iso / Info / Extras / SendKeys / SNDKEY32.PAS
Pascal/Delphi Source File  |  1998-06-05  |  14KB  |  487 lines
  1. (*
  2. SendKeys routine for 32-bit Delphi.
  3.  
  4. Written by Ken Henderson
  5.  
  6. Copyright (c) 1995 Ken Henderson     email:khen@compuserve.com
  7.  
  8. This unit includes two routines that simulate popular Visual Basic
  9. routines: Sendkeys and AppActivate.  SendKeys takes a PChar
  10. as its first parameter and a boolean as its second, like so:
  11.  
  12. SendKeys('KeyString', Wait);
  13.  
  14. where KeyString is a string of key names and modifiers that you want
  15. to send to the current input focus and Wait is a boolean variable or value
  16. that indicates whether SendKeys should wait for each key message to be
  17. processed before proceeding.  See the table below for more information.
  18.  
  19. AppActivate also takes a PChar as its only parameter, like so:
  20.  
  21. AppActivate('WindowName');
  22.  
  23. where WindowName is the name of the window that you want to make the
  24. current input focus.
  25.  
  26. SendKeys supports the Visual Basic SendKeys syntax, as documented below.
  27.  
  28. Supported modifiers:
  29.  
  30. + = Shift
  31. ^ = Control
  32. % = Alt
  33.  
  34. Surround sequences of characters or key names with parentheses in order to
  35. modify them as a group.  For example, '+abc' shifts only 'a', while '+(abc)' shifts
  36. all three characters.
  37.  
  38. Supported special characters
  39.  
  40. ~ = Enter
  41. ( = Begin modifier group (see above)
  42. ) = End modifier group (see above)
  43. { = Begin key name text (see below)
  44. } = End key name text (see below)
  45.  
  46. Supported characters:
  47.  
  48. Any character that can be typed is supported.  Surround the modifier keys
  49. listed above with braces in order to send as normal text.
  50.  
  51. Supported key names (surround these with braces):
  52.  
  53. BKSP, BS, BACKSPACE
  54. BREAK
  55. CAPSLOCK
  56. CLEAR
  57. DEL
  58. DELETE
  59. DOWN
  60. END
  61. ENTER
  62. ESC
  63. ESCAPE
  64. F1
  65. F2
  66. F3
  67. F4
  68. F5
  69. F6
  70. F7
  71. F8
  72. F9
  73. F10
  74. F11
  75. F12
  76. F13
  77. F14
  78. F15
  79. F16
  80. HELP
  81. HOME
  82. INS
  83. LEFT
  84. NUMLOCK
  85. PGDN
  86. PGUP
  87. PRTSC
  88. RIGHT
  89. SCROLLLOCK
  90. TAB
  91. UP
  92.  
  93. Follow the keyname with a space and a number to send the specified key a
  94. given number of times (e.g., {left 6}).
  95. *)
  96.  
  97. unit sndkey32;
  98.  
  99. interface
  100.  
  101. Uses SysUtils, Windows, Messages;
  102.  
  103. Function SendKeys(SendKeysString : PChar; Wait : Boolean) : Boolean;
  104. function AppActivate(WindowName : PChar) : boolean;
  105.  
  106. {Buffer for working with PChar's}
  107.  
  108. const
  109.   WorkBufLen = 40;
  110. var
  111.   WorkBuf : array[0..WorkBufLen] of Char;
  112.  
  113. implementation
  114. type
  115.   THKeys = array[0..pred(MaxLongInt)] of byte;
  116. var
  117.   AllocationSize : integer;
  118.  
  119. (*
  120. Converts a string of characters and key names to keyboard events and
  121. passes them to Windows.
  122.  
  123. Example syntax:
  124.  
  125. SendKeys('abc123{left}{left}{left}def{end}456{left 6}ghi{end}789', True);
  126.  
  127. *)
  128.  
  129. Function SendKeys(SendKeysString : PChar; Wait : Boolean) : Boolean;
  130. type
  131.   WBytes = array[0..pred(SizeOf(Word))] of Byte;
  132.  
  133.   TSendKey = record
  134.     Name : ShortString;
  135.     VKey : Byte;
  136.   end;
  137.  
  138. const
  139.   {Array of keys that SendKeys recognizes.
  140.  
  141.   If you add to this list, you must be sure to keep it sorted alphabetically
  142.   by Name because a binary search routine is used to scan it.}
  143.  
  144.   MaxSendKeyRecs = 41;
  145.   SendKeyRecs : array[1..MaxSendKeyRecs] of TSendKey =
  146.   (
  147.    (Name:'BKSP';            VKey:VK_BACK),
  148.    (Name:'BS';              VKey:VK_BACK),
  149.    (Name:'BACKSPACE';       VKey:VK_BACK),
  150.    (Name:'BREAK';           VKey:VK_CANCEL),
  151.    (Name:'CAPSLOCK';        VKey:VK_CAPITAL),
  152.    (Name:'CLEAR';           VKey:VK_CLEAR),
  153.    (Name:'DEL';             VKey:VK_DELETE),
  154.    (Name:'DELETE';          VKey:VK_DELETE),
  155.    (Name:'DOWN';            VKey:VK_DOWN),
  156.    (Name:'END';             VKey:VK_END),
  157.    (Name:'ENTER';           VKey:VK_RETURN),
  158.    (Name:'ESC';             VKey:VK_ESCAPE),
  159.    (Name:'ESCAPE';          VKey:VK_ESCAPE),
  160.    (Name:'F1';              VKey:VK_F1),
  161.    (Name:'F10';             VKey:VK_F10),
  162.    (Name:'F11';             VKey:VK_F11),
  163.    (Name:'F12';             VKey:VK_F12),
  164.    (Name:'F13';             VKey:VK_F13),
  165.    (Name:'F14';             VKey:VK_F14),
  166.    (Name:'F15';             VKey:VK_F15),
  167.    (Name:'F16';             VKey:VK_F16),
  168.    (Name:'F2';              VKey:VK_F2),
  169.    (Name:'F3';              VKey:VK_F3),
  170.    (Name:'F4';              VKey:VK_F4),
  171.    (Name:'F5';              VKey:VK_F5),
  172.    (Name:'F6';              VKey:VK_F6),
  173.    (Name:'F7';              VKey:VK_F7),
  174.    (Name:'F8';              VKey:VK_F8),
  175.    (Name:'F9';              VKey:VK_F9),
  176.    (Name:'HELP';            VKey:VK_HELP),
  177.    (Name:'HOME';            VKey:VK_HOME),
  178.    (Name:'INS';             VKey:VK_INSERT),
  179.    (Name:'LEFT';            VKey:VK_LEFT),
  180.    (Name:'NUMLOCK';         VKey:VK_NUMLOCK),
  181.    (Name:'PGDN';            VKey:VK_NEXT),
  182.    (Name:'PGUP';            VKey:VK_PRIOR),
  183.    (Name:'PRTSC';           VKey:VK_PRINT),
  184.    (Name:'RIGHT';           VKey:VK_RIGHT),
  185.    (Name:'SCROLLLOCK';      VKey:VK_SCROLL),
  186.    (Name:'TAB';             VKey:VK_TAB),
  187.    (Name:'UP';              VKey:VK_UP)
  188.   );
  189.  
  190.   {Extra VK constants missing from Delphi's Windows API interface}
  191.   VK_NULL=0;
  192.   VK_SemiColon=186;
  193.   VK_Equal=187;
  194.   VK_Comma=188;
  195.   VK_Minus=189;
  196.   VK_Period=190;
  197.   VK_Slash=191;
  198.   VK_BackQuote=192;
  199.   VK_LeftBracket=219;
  200.   VK_BackSlash=220;
  201.   VK_RightBracket=221;
  202.   VK_Quote=222;
  203.   VK_Last=VK_Quote;
  204.  
  205.   ExtendedVKeys : set of byte =
  206.   [VK_Up,
  207.    VK_Down,
  208.    VK_Left,
  209.    VK_Right,
  210.    VK_Home,
  211.    VK_End,
  212.    VK_Prior,  {PgUp}
  213.    VK_Next,   {PgDn}
  214.    VK_Insert,
  215.    VK_Delete];
  216.  
  217. const
  218.   INVALIDKEY = $FFFF {Unsigned -1};
  219.   VKKEYSCANSHIFTON = $01;
  220.   VKKEYSCANCTRLON = $02;
  221.   VKKEYSCANALTON = $04;
  222.   UNITNAME = 'SendKeys';
  223. var
  224.   UsingParens, ShiftDown, ControlDown, AltDown, FoundClose : Boolean;
  225.   PosSpace : Byte;
  226.   I, L : Integer;
  227.   NumTimes, MKey : Word;
  228.   KeyString : String[20];
  229.  
  230. procedure DisplayMessage(Message : PChar);
  231. begin
  232.   MessageBox(0,Message,UNITNAME,0);
  233. end;
  234.  
  235. function BitSet(BitTable, BitMask : Byte) : Boolean;
  236. begin
  237.   Result:=ByteBool(BitTable and BitMask);
  238. end;
  239.  
  240. procedure SetBit(var BitTable : Byte; BitMask : Byte);
  241. begin
  242.   BitTable:=BitTable or Bitmask;
  243. end;
  244.  
  245. Procedure KeyboardEvent(VKey, ScanCode : Byte; Flags : Longint);
  246. var
  247.   KeyboardMsg : TMsg;
  248. begin
  249.   keybd_event(VKey, ScanCode, Flags,0);
  250.   If (Wait) then While (PeekMessage(KeyboardMsg,0,WM_KEYFIRST, WM_KEYLAST, PM_REMOVE)) do begin
  251.     TranslateMessage(KeyboardMsg);
  252.     DispatchMessage(KeyboardMsg);
  253.   end;
  254. end;
  255.  
  256. Procedure SendKeyDown(VKey: Byte; NumTimes : Word; GenUpMsg : Boolean);
  257. var
  258.   Cnt : Word;
  259.   ScanCode : Byte;
  260.   NumState : Boolean;
  261.   KeyBoardState : TKeyboardState;
  262. begin
  263.   If (VKey=VK_NUMLOCK) then begin
  264.     NumState:=ByteBool(GetKeyState(VK_NUMLOCK) and 1);
  265.     GetKeyBoardState(KeyBoardState);
  266.     If NumState then KeyBoardState[VK_NUMLOCK]:=(KeyBoardState[VK_NUMLOCK] and not 1)
  267.     else KeyBoardState[VK_NUMLOCK]:=(KeyBoardState[VK_NUMLOCK] or 1);
  268.     SetKeyBoardState(KeyBoardState);
  269.     exit;
  270.   end;
  271.  
  272.   ScanCode:=Lo(MapVirtualKey(VKey,0));
  273.   For Cnt:=1 to NumTimes do
  274.     If (VKey in ExtendedVKeys)then begin
  275.       KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY);
  276.       If (GenUpMsg) then
  277.         KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP)
  278.     end else begin
  279.       KeyboardEvent(VKey, ScanCode, 0);
  280.       If (GenUpMsg) then KeyboardEvent(VKey, ScanCode, KEYEVENTF_KEYUP);
  281.     end;
  282. end;
  283.  
  284. Procedure SendKeyUp(VKey: Byte);
  285. var
  286.   ScanCode : Byte;
  287. begin
  288.   ScanCode:=Lo(MapVirtualKey(VKey,0));
  289.   If (VKey in ExtendedVKeys)then
  290.     KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY and KEYEVENTF_KEYUP)
  291.   else KeyboardEvent(VKey, ScanCode, KEYEVENTF_KEYUP);
  292. end;
  293.  
  294. Procedure SendKey(MKey: Word; NumTimes : Word; GenDownMsg : Boolean);
  295. begin
  296.   If (BitSet(Hi(MKey),VKKEYSCANSHIFTON)) then SendKeyDown(VK_SHIFT,1,False);
  297.   If (BitSet(Hi(MKey),VKKEYSCANCTRLON)) then SendKeyDown(VK_CONTROL,1,False);
  298.   If (BitSet(Hi(MKey),VKKEYSCANALTON)) then SendKeyDown(VK_MENU,1,False);
  299.   SendKeyDown(Lo(MKey), NumTimes, GenDownMsg);
  300.   If (BitSet(Hi(MKey),VKKEYSCANSHIFTON)) then SendKeyUp(VK_SHIFT);
  301.   If (BitSet(Hi(MKey),VKKEYSCANCTRLON)) then SendKeyUp(VK_CONTROL);
  302.   If (BitSet(Hi(MKey),VKKEYSCANALTON)) then SendKeyUp(VK_MENU);
  303. end;
  304.  
  305. {Implements a simple binary search to locate special key name strings}
  306.  
  307. Function StringToVKey(KeyString : ShortString) : Word;
  308. var
  309.   Found, Collided : Boolean;
  310.   Bottom, Top, Middle : Byte;
  311. begin
  312.   Result:=INVALIDKEY;
  313.   Bottom:=1;
  314.   Top:=MaxSendKeyRecs;
  315.   Found:=false;
  316.   Middle:=(Bottom+Top) div 2;
  317.   Repeat
  318.     Collided:=((Bottom=Middle) or (Top=Middle));
  319.     If (KeyString=SendKeyRecs[Middle].Name) then begin
  320.        Found:=True;
  321.        Result:=SendKeyRecs[Middle].VKey;
  322.     end else begin
  323.        If (KeyString>SendKeyRecs[Middle].Name) then Bottom:=Middle
  324.        else Top:=Middle;
  325.        Middle:=(Succ(Bottom+Top)) div 2;
  326.     end;
  327.   Until (Found or Collided);
  328.   If (Result=INVALIDKEY) then DisplayMessage('Invalid Key Name');
  329. end;
  330.  
  331. procedure PopUpShiftKeys;
  332. begin
  333.   If (not UsingParens) then begin
  334.     If ShiftDown then SendKeyUp(VK_SHIFT);
  335.     If ControlDown then SendKeyUp(VK_CONTROL);
  336.     If AltDown then SendKeyUp(VK_MENU);
  337.     ShiftDown:=false;
  338.     ControlDown:=false;
  339.     AltDown:=false;
  340.   end;
  341. end;
  342.  
  343. begin
  344.   AllocationSize:=MaxInt;
  345.   Result:=false;
  346.   UsingParens:=false;
  347.   ShiftDown:=false;
  348.   ControlDown:=false;
  349.   AltDown:=false;
  350.   I:=0;
  351.   L:=StrLen(SendKeysString);
  352.   If (L>AllocationSize) then L:=AllocationSize;
  353.   If (L=0) then Exit;
  354.  
  355.   While (I<L) do begin
  356.     case SendKeysString[I] of
  357.     '(' : begin
  358.             UsingParens:=True;
  359.             Inc(I);
  360.           end;
  361.     ')' : begin
  362.             UsingParens:=False;
  363.             PopUpShiftKeys;
  364.             Inc(I);
  365.           end;
  366.     '%' : begin
  367.              AltDown:=True;
  368.              SendKeyDown(VK_MENU,1,False);
  369.              Inc(I);
  370.           end;
  371.     '+' :  begin
  372.              ShiftDown:=True;
  373.              SendKeyDown(VK_SHIFT,1,False);
  374.              Inc(I);
  375.            end;
  376.     '^' :  begin
  377.              ControlDown:=True;
  378.              SendKeyDown(VK_CONTROL,1,False);
  379.              Inc(I);
  380.            end;
  381.     '{' : begin
  382.             NumTimes:=1;
  383.             If (SendKeysString[Succ(I)]='{') then begin
  384.               MKey:=VK_LEFTBRACKET;
  385.               SetBit(Wbytes(MKey)[1],VKKEYSCANSHIFTON);
  386.               SendKey(MKey,1,True);
  387.               PopUpShiftKeys;
  388.               Inc(I,3);
  389.               Continue;
  390.             end;
  391.             KeyString:='';
  392.             FoundClose:=False;
  393.             While (I<=L) do begin
  394.               Inc(I);
  395.               If (SendKeysString[I]='}') then begin
  396.                 FoundClose:=True;
  397.                 Inc(I);
  398.                 Break;
  399.               end;
  400.               KeyString:=KeyString+Upcase(SendKeysString[I]);
  401.             end;
  402.             If (Not FoundClose) then begin
  403.                DisplayMessage('No Close');
  404.                Exit;
  405.             end;
  406.             If (SendKeysString[I]='}') then begin
  407.               MKey:=VK_RIGHTBRACKET;
  408.               SetBit(Wbytes(MKey)[1],VKKEYSCANSHIFTON);
  409.               SendKey(MKey,1,True);
  410.               PopUpShiftKeys;
  411.               Inc(I);
  412.               Continue;
  413.             end;
  414.             PosSpace:=Pos(' ',KeyString);
  415.             If (PosSpace<>0) then begin
  416.                NumTimes:=StrToInt(Copy(KeyString,Succ(PosSpace),Length(KeyString)-PosSpace));
  417.                KeyString:=Copy(KeyString,1,Pred(PosSpace));
  418.             end;
  419.             If (Length(KeyString)=1) then MKey:=vkKeyScan(KeyString[1])
  420.             else MKey:=StringToVKey(KeyString);
  421.             If (MKey<>INVALIDKEY) then begin
  422.               SendKey(MKey,NumTimes,True);
  423.               PopUpShiftKeys;
  424.               Continue;
  425.             end;
  426.           end;
  427.     '~' : begin
  428.             SendKeyDown(VK_RETURN,1,True);
  429.             PopUpShiftKeys;
  430.             Inc(I);
  431.           end;
  432.     else  begin
  433.              MKey:=vkKeyScan(SendKeysString[I]);
  434.              If (MKey<>INVALIDKEY) then begin
  435.                SendKey(MKey,1,True);
  436.                PopUpShiftKeys;
  437.              end else DisplayMessage('Invalid KeyName');
  438.              Inc(I);
  439.           end;
  440.     end;
  441.   end;
  442.   Result:=true;
  443.   PopUpShiftKeys;
  444. end;
  445.  
  446. {AppActivate
  447.  
  448. This is used to set the current input focus to a given window using its
  449. name.  This is especially useful for ensuring a window is active before
  450. sending it input messages using the SendKeys function.  You can specify
  451. a window's name in its entirety, or only portion of it, beginning from
  452. the left.
  453.  
  454. }
  455.  
  456. var
  457.   WindowHandle : HWND;
  458.  
  459. function EnumWindowsProc(WHandle: HWND; lParam: LPARAM): BOOL; export; stdcall;
  460. const
  461.   MAX_WINDOW_NAME_LEN = 80;
  462. var
  463.   WindowName : array[0..MAX_WINDOW_NAME_LEN] of char;
  464. begin
  465.   {Can't test GetWindowText's return value since some windows don't have a title}
  466.   GetWindowText(WHandle,WindowName,MAX_WINDOW_NAME_LEN);
  467.   Result := (StrLIComp(WindowName,PChar(lParam), StrLen(PChar(lParam))) <> 0);
  468.   If (not Result) then WindowHandle:=WHandle;
  469. end;
  470.  
  471. function AppActivate(WindowName : PChar) : boolean;
  472. begin
  473.   try
  474.     Result:=true;
  475.     WindowHandle:=FindWindow(nil,WindowName);
  476.     If (WindowHandle=0) then EnumWindows(@EnumWindowsProc,Integer(PChar(WindowName)));
  477.     If (WindowHandle<>0) then begin
  478.       SendMessage(WindowHandle, WM_SYSCOMMAND, SC_HOTKEY, WindowHandle);
  479.       SendMessage(WindowHandle, WM_SYSCOMMAND, SC_RESTORE, WindowHandle);
  480.     end else Result:=false;
  481.   except
  482.     on Exception do Result:=false;
  483.   end;
  484. end;
  485.  
  486. end.
  487.