Channels ▼
RSS

Keys to the Kingdom


DDJ, Spring 1997: Listings

Keys to the Kingdom

Spring 1997 Dr. Dobb's Journal

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



Related Reading


More Insights






Currently we allow the following HTML tags in comments:

Single tags

These tags can be used alone and don't need an ending tag.

<br> Defines a single line break

<hr> Defines a horizontal line

Matching tags

These require an ending tag - e.g. <i>italic text</i>

<a> Defines an anchor

<b> Defines bold text

<big> Defines big text

<blockquote> Defines a long quotation

<caption> Defines a table caption

<cite> Defines a citation

<code> Defines computer code text

<em> Defines emphasized text

<fieldset> Defines a border around elements in a form

<h1> This is heading 1

<h2> This is heading 2

<h3> This is heading 3

<h4> This is heading 4

<h5> This is heading 5

<h6> This is heading 6

<i> Defines italic text

<p> Defines a paragraph

<pre> Defines preformatted text

<q> Defines a short quotation

<samp> Defines sample computer code text

<small> Defines small text

<span> Defines a section in a document

<s> Defines strikethrough text

<strike> Defines strikethrough text

<strong> Defines strong text

<sub> Defines subscripted text

<sup> Defines superscripted text

<u> Defines underlined text

Dr. Dobb's encourages readers to engage in spirited, healthy debate, including taking us to task. However, Dr. Dobb's moderates all comments posted to our site, and reserves the right to modify or remove any content that it determines to be derogatory, offensive, inflammatory, vulgar, irrelevant/off-topic, racist or obvious marketing or spam. Dr. Dobb's further reserves the right to disable the profile of any commenter participating in said activities.

 
Disqus Tips To upload an avatar photo, first complete your Disqus profile. | View the list of supported HTML tags you can use to style comments. | Please read our commenting policy.