Keys to the Kingdom

by 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