Keys to the Kingdom
Spring 1997 Dr. Dobb's Journalby Al Williams
Listing One
unit SendKey; interface procedure SendKeys(s : String); function cvtkey(var s : String; i:Integer; var key :Integer; var count: Integer; var len : Integer; var letshift : Boolean; var shift : Boolean; var letctrl : Boolean; var ctrl : Boolean; var letalt : Boolean; var alt : Boolean; var shiftlock : Boolean) : Boolean; implementation uses SysUtils, Windows; { symbol table record } type tokentable = record token : String; vkey : Integer; end; { global symbol table } var tbl : array [0..21] of tokentable; tbllen : Integer; { Get a number from the input string } function GetNum(s:String;i:Integer;var len:Integer) : Integer; var tmp : String; begin tmp:=''; while (s[i]>='0') and (s[i]<='9') do begin tmp:=tmp+s[i]; i:=i+1; len:=len+1; end; Result:=StrToInt(tmp); end; { Process braced characters } procedure procbrace(var s:String; i:Integer; var key:Integer; var len:Integer; var count:Integer; var letshift:Boolean; var letctrl:Boolean; var letalt:Boolean; var shift:Boolean; var ctrl:Boolean; var alt:Boolean; var shiftlock:Boolean); var j: Integer; tmp : String; begin count:=1; { 3 cases: x, xxx, xxx ## } { if single character case } if (s[i+2]='}') or (s[i+2]=' ') then begin if s[i+2]=' ' then { read count if present } begin count:=GetNum(s,i+3,len); len:=len+1; end; len:=len+2; { convert quoted key } key:=Integer(s[i+1]); { convert key -- pass zero to prevent special interp. } cvtkey(s,0,key,count,len,letshift,shift, letctrl,ctrl,letalt,alt,shiftlock); end else { multicharacter sequence } begin { find next brace or space } j:=1; tmp:=''; while (s[i+j]<>' ') and (s[i+j]<>'}') do begin tmp:=tmp+s[i+j]; j:=j+1; len:=len+1; end; if s[i+j]=' ' then { read count } begin count:=GetNum(s,i+j+1,len); len:=len+1; end; len:=len+1; {check for special tokens} tmp:=UpperCase(tmp); if tmp[1]='F' then { F Keys } begin key:=GetNum(tmp,2,j)+VK_F1-1; end; { chop token to 3 characters or less } if Length(tmp)>3 then tmp:=Copy(tmp,1,3); { handle pause specially } if CompareStr(tmp,'PAU')=0 then begin Sleep(count); key:=0; exit; end; { find entry in table } key:=0; for j:=0 to tbllen-1 do begin if CompareStr(tbl[j].token,tmp)=0 then begin key:=tbl[j].vkey; break; end; end; { if key=0 here then something is bad } end; { end of token processing } end; { Wrapper around kebyd_event } procedure keybd(vk : integer;down : Boolean); var scan : Integer; flg : Integer; begin scan:=MapVirtualKey(vk,0); { find VK } if down then flg:=0 else flg:=KEYEVENTF_KEYUP; keybd_event(vk,scan,flg,0); end; function cvtkey(var s : String; i:Integer; var key : Integer; var count: Integer; var len : Integer; var letshift : Boolean; var shift : Boolean; var letctrl : Boolean; var ctrl : Boolean; var letalt : Boolean; var alt : Boolean; var shiftlock : Boolean) : Boolean; var rv : LongInt; c : Char; begin if i<>0 then { if i=0 then supress special processing } begin len:=1; count:=1; end; Result:=False; if i<>0 then c:=s[i] else c:=chr(0); { scan for special character } case c of '{': begin procbrace(s,i,key,len,count,letshift, letctrl,letalt,shift,ctrl, alt,shiftlock); if key=0 then Result:=True; exit; end; '~': begin key:=VK_RETURN; end; '+': begin shift:=True; Result:=True; end; '^': begin ctrl:=True; Result:=True; end; '%': begin alt:=True; Result:=True; end; '(': begin shiftlock:=True; Result:=True; end; ')': begin shiftlock:=False; Result:=True; end; else begin if c=chr(0) then c:=chr(key); rv:=VkKeyScan(c); { normal character } key:=rv and $FF; if (rv and $100) = $100 then letshift:=True else letshift:=False; if (rv and $200) = $200 then letctrl:=True else letctrl:=False; if (rv and $400) = $400 then letalt:=True else letalt:=False; end; end; end; { The main point... } procedure SendKeys(s:String); var i,j : Integer; c : Char; key : Integer; shift : Boolean; letshift : Boolean; ctrl : Boolean; letctrl : Boolean; alt : Boolean; letalt : Boolean; shiftlock : Boolean; len : Integer; count : Integer; begin { init } len:=1; shiftlock:=False; letalt:=False; alt:=False; letctrl:=False; ctrl:=False; letshift:=False; shift:=False; { for each character in string } for i := 1 to Length(s) do begin if len<>1 then { skip characters on request } begin len:=len-1; continue; end; c:=s[i]; { convert key } if cvtkey(s,i,key,count,len,letshift,shift, letctrl,ctrl,letalt,alt,shiftlock) then continue; { fake modifier keys } if shift or letshift then keybd(VK_SHIFT,True); if ctrl or letctrl then keybd(VK_CONTROL,True); if alt or letalt then keybd(VK_MENU,True); { do requested number of keystrokes } for j :=1 to count do begin keybd(key,True); keybd(key,False); sleep(50); { wait 50ms} end; { clear modifiers unless locked } if alt or letalt and not shiftlock then keybd(VK_MENU,False); if ctrl or letctrl and not shiftlock then keybd(VK_CONTROL,False); if shift or letshift and not shiftlock then keybd(VK_SHIFT,FALSE); if not shiftlock then begin alt:=False; ctrl:=False; shift:=False; end; end; end; initialization tbl[0].token:='BAC'; tbl[0].vkey:=VK_BACK; tbl[1].token:='BS'; tbl[1].vkey:=VK_BACK; tbl[2].token:='BKS'; tbl[2].vkey:=VK_BACK; tbl[3].token:='BRE'; tbl[3].vkey:=VK_CANCEL; tbl[4].token:='CAP'; tbl[4].vkey:=VK_CAPITAL; tbl[5].token:='DEL'; tbl[5].vkey:=VK_DELETE; tbl[6].token:='DOW'; tbl[6].vkey:=VK_DOWN; tbl[7].token:='END'; tbl[7].vkey:=VK_END; tbl[8].token:='ENT'; tbl[8].vkey:=VK_RETURN; tbl[9].token:='ESC'; tbl[9].vkey:=VK_ESCAPE; tbl[10].token:='HEL'; tbl[10].vkey:=VK_HELP; tbl[11].token:='HOM'; tbl[11].vkey:=VK_HOME; tbl[12].token:='INS'; tbl[12].vkey:=VK_INSERT; tbl[13].token:='LEF'; tbl[13].vkey:=VK_LEFT; tbl[14].token:='NUM'; tbl[14].vkey:=VK_NUMLOCK; tbl[15].token:='PGD'; tbl[15].vkey:=VK_NEXT; tbl[16].token:='PGU'; tbl[16].vkey:=VK_PRIOR; tbl[17].token:='PRT'; tbl[17].vkey:=VK_SNAPSHOT; tbl[18].token:='RIG'; tbl[18].vkey:=VK_RIGHT; tbl[19].token:='SCR'; tbl[19].vkey:=VK_SCROLL; tbl[20].token:='TAB'; tbl[20].vkey:=VK_TAB; tbl[21].token:='UP'; tbl[21].vkey:=VK_UP; tbllen:=22; end. End Listing