Keys to the Kingdom
Spring 1997 Dr. Dobb's Journal
by Al Williams
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