Delphiran - Delphi Tips
Question :
How can I send a key to another application ?

Answer :

unit sendkey;    // Sends keys to any window

interface

uses
  Windows, Messages, dialogs,sysutils,WindowList,strings;

//This unit requires the WINLDOWLIST unit in order for the FindAWindow
// function to compile. That function is NOT necessary to use this unit; if
// you don't have the WINDOWLIST unit (which is freeware) remove the declaration
// above, comment out the FindAWindow function, and this unit should compile.

const
    BEGINBRACE = '{';
    ENDBRACE = '}';

procedure SimulateKeystroke(Key : byte; extra : DWORD);
procedure SimulateKeyDown(Key : byte);
procedure SimulateKeyUp(Key : byte);
procedure SendKeys(s : string; targethwnd : hwnd);
Procedure SendKeysEx(s : string; targethwnd : hwnd);
function FindInBraces(s : string; StartAt : integer): string;
function CountBraceSets(s : string) : integer;
function GetBraceValue(s : string; setnum : integer) : string;
function FindNextSetBegin(s : string; StartAt : integer): integer;
function FindNextSetEnd(s : string; StartAt : integer): integer;
Function ReplaceSpecialKeys(keystr : string) : string;
procedure sendinbraces(s : string; targethwnd : hwnd);
procedure keystroke( key : byte);
Function FindaWindow(title : string; partial : boolean; wlist : TWindowList): hwnd;

(*
Some Virtual Keys you can use:

VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT, VK_END,
VK_HOME, VK_PRIOR, VK_NEXT, VK_ESCAPE,
VK_CONTROL, VK_MENU (ALT)

See end of this file for a more complete list.

*)

implementation

// ***********************************
// SimulateKeyStroke
//
// Simulates hitting a key, which is sent to active
// window.
//
//************************************

procedure SimulateKeystroke(Key : byte; extra : DWORD);
begin
  keybd_event(Key,extra,0,0);
  keybd_event(Key, extra,KEYEVENTF_KEYUP,0);
end;

// ***********************************
// SimulateKeyDown
//
// Simulates holding down a key, such as shift or ALT
//
//
//************************************

procedure SimulateKeyDown(Key : byte);
  begin
       keybd_event(Key, 0, 0, 0);
  end;

// ***********************************
// SimulateKeyUp
//
// Simulates releasing a key, such as shift or ALT
//
//
//************************************
procedure SimulateKeyUp(Key : byte);
  begin
       keybd_event(Key, 0, KEYEVENTF_KEYUP, 0);
  end;

// ***********************************
// SendKeys
//
// Sends a string to the window specified
// by TargetHWND. Uses SetForegroundWindow
// to make sure keys go to the right place.
//
//************************************
procedure SendKeys(s : string; targethwnd : hwnd);
var
   i : integer;
   flag : bool;
   w : word;
   d1,d2 : integer; // for delay loop
 begin
    SetForegroundWindow(targetHwnd);  // GET TO THE RIGHT WINDOW
    {Get the state of the caps lock key}
     flag := not GetKeyState(VK_CAPITAL) and 1 = 0;
     {If the caps lock key is on then turn it off}
     if flag then
        SimulateKeystroke(VK_CAPITAL, 0);
     for i := 1 to Length(s) do
      begin
        for d1 := 1 to 1000 do // Delay a tiny bit to allow keys to be accepted.
          for d2 := 1 to 250 do // THis needs tested on a SLOW PC!
            begin
            end;
        SetForegroundWindow(targetHwnd); // REQUIRED! Verify target window
        w := VkKeyScan(s[i]);
        {If there is not an error in the key translation}
        if ((HiByte(w) ‹› $FF) and (LoByte(w) ‹› $FF)) then
            begin
              {If the key requires the shift key down - hold it down}
               if HiByte(w) and 1 = 1 then
                 SimulateKeyDown(VK_SHIFT);
              {Send the VK_KEY}
               SimulateKeystroke(LoByte(w), 0);
              {If the key required the shift key down - release it}
               if HiByte(w) and 1 = 1 then
                 SimulateKeyUp(VK_SHIFT);
             end;
      end;
      {if the caps lock key was on at start, turn it back on}
      if flag then
          SimulateKeystroke(VK_CAPITAL, 0);
 end;

function FindInBraces(s : string; StartAt : integer): string;
// Given a string and a starting point, finds the next set of
// braces and returns the characters inside
var Beginpos, Endpos : integer;
    bbrace, ebrace : string;
begin
   bbrace := BEGINBRACE;
   ebrace := ENDBRACE;
   Beginpos := forwardpos(bbrace,s,StartAt);
   Endpos := forwardpos(ebrace,s,beginpos+1);
   Result := copy(s,beginpos+1,endpos-beginpos-1);
end;

// Returns the location of the next BEGINBRACE character which denotes
// the beginning of a complete set. In order to be counted, the set must
// be terminated with an ENDBRACE character. If no BEGINBRACE character is
// found to denote the beginning of a set after the specified location,
// function returns 0.
function FindNextSetBegin(s : string; StartAt : integer): integer;
var x,bbrace,setcount : integer;
    InSet,done : boolean;
begin
   setcount := 0;
   bbrace := 0;
   InSet := false;
   done := false;
   x := 1;
   while (x ‹= length(s))and (not done) do
     begin
       if (s[x] = BEGINBRACE) and (not Inset) then
        begin
          InSet := true;
          bbrace := x; // we're PROBABLY beginning a set
        end;
       if (s[x] = ENDBRACE) and (InSet) then
        begin
          Inset := false;
          inc(setCount); // we just finished a set so count it.
          if bbrace ›= StartAt then Done := true;
        end;
        inc(x);
     end;
   if (done) and (setcount › 0) then
     Result := bbrace
   else
     Result := 0;
end;

// Returns the next END BRACE location equal to or after the
// specified position in the string. Since Brace sets are counted
// from the VERY BEGINNING of the string, this MAY NOT return the
// next occurence of the end brace character.
// Example: FindNextSetEnd('1}3}5{}',1) would return 7, because the
// set beginning is at position 6. Returns 0 if no Set End Brace is
// found after the given location.
function FindNextSetEnd(s : string; StartAt : integer): integer;
var x,bbrace,ebrace,setcount : integer;
    InSet,done : boolean;
begin
   setcount := 0;
   bbrace := 0;
   ebrace := 0;
   InSet := false;
   done := false;
   x := 1;
   while (x ‹= length(s))and (not done) do
     begin
       if (s[x] = BEGINBRACE) and (not Inset) then
        begin
          InSet := true;
          bbrace := x; // we're PROBABLY beginning a set
        end;
       if (s[x] = ENDBRACE) and (InSet) then
        begin
          Inset := false;
          ebrace := x;
          inc(setCount); // we just finished a set so count it.
          if bbrace ›= StartAt then Done := true;
        end;
        inc(x);
     end;
   if (done) and (setcount › 0) then
     Result := ebrace
   else
     Result := 0;
end;

// Returns the number of full sets of braces in a given string
// Note - doesn't count braces that aren't making up a set.
// So {{{} counts as one, and {{}} counts as one. {}{} would be 2.
// No "set inside a set" functionality is taken into account.
function CountBraceSets(s : string): integer;
var x,setcount : integer;
    InSet : boolean;
begin
   setcount := 0;
   InSet := false;
   x := 1;
   while (x ‹= length(s)) do
     begin
       if (s[x] = BEGINBRACE) and (not Inset) then
        begin
          InSet := true; // we're PROBABLY beginning a set
        end;
       if (s[x] = ENDBRACE) and (InSet) then
        begin
          Inset := false;
          inc(setCount); // we just finished a set so count it.
        end;
        inc(x);
     end;
     Result := setcount;
end;

function GetBraceValue(s : string; SetNum : integer) : string;
// Returns the text in between a set of braces. SetNum denotes the
// set to return.
var count,sloc : integer;
begin
    if (setnum ‹= countbracesets(s)) and (setnum › 0) then
    begin
     count := 1;
     sloc := FindNextSetBegin(s,1);
     while count ‹= (setnum-1) do
       begin
         sloc := FindNextSetBegin(s,sloc);
         inc(count);
         sloc := FindNextSetEnd(s,sloc);
       end;
       result := findinbraces(s,sloc);
    end
    else
      result := '';
end;

// For special codes which can be translated directly into one character
// bytes, we use this function to cconvert them (ie {ENTER}=chr(13) etc)
// This gets them out of the way before more involved code-handling
// routines attempt to sort out the remaining brace codes. This function
// should not need to be used by any user function; it's a helper function
// for other functions in this unit.
Function ReplaceSpecialKeys(keystr : string) : string;
// Replaces certain brace characters with their ascii equivalents
var Flags: TReplaceFlags;
begin
  Flags := [rfReplaceAll,rfIgnoreCase];
  keystr := StringReplace(keystr, '{ENTER}', chr(13), Flags);
  keystr := StringReplace(keystr, '{TAB}', chr(9), Flags);
  keystr := StringReplace(keystr, '{ESC}', chr(27), Flags);
  keystr := StringReplace(keystr, '{ESCAPE}', chr(27), Flags);
  result := keystr;
end;

//*****************************************************************
// SendKeysEx - An Extended Sendkeys function which converts special
// text combinations into keystrokes. Example: {ENTER} is turned into
// chr(13), {TAB} = chr(9), etc. Also, {ALT-F} sends ALT and F, and
// ALTDOWN holds down the ALT key, ALTUP lets it up, etc. See the code
// for all the special codes. This requires the SendKey function, but
// can be used in place of the SendKeys function. The Sendkeys function
// doesn't handle special codes like SendKeysEx does.
//*********************************************************************
Procedure SendKeysEx( s : string; targethwnd : hwnd);
// Replaces special keys, and handles ALT and CTRL keys
var bb,eb : integer;
    tempstr,braceval,workstr : string;
begin
  SetForegroundWindow(targetHwnd); // Make sure the correct window recieves focus
  workstr := ReplaceSpecialKeys(s); // Turn {ENTER}, {TAB}, etc into chars first
  if CountBraceSets(workstr) › 0 then // we have braces
    begin
      bb := FindNextSetBegin(workstr,1); // get the location of first brace set
      repeat
        //bb := FindNextSetBegin(workstr,currentpos); // get the location of first brace set
         eb := FindNextSetEnd(workstr,bb); // set the brace end too
         if bb › 1 then //send keys before current set of braces
          begin
            tempstr := copy(workstr,1,bb-1); // copy data
            sendkeys(tempstr,targethwnd); // send it
            delete(workstr,1,bb-1); // wipe out everything we just sent
            // reset bb and eb since we changed string size
            bb := FindNextSetBegin(workstr,1);
            //eb := FindNextSetEnd(workstr,bb);
            //currentpos := bb; // brace end now becomes beginning of string
          end
         else
          begin
            braceval := getbracevalue(workstr,1); // return what's in set of braces
            SendInBraces(braceval,targethwnd); // handle it
            delete(workstr,1,eb); // wipe brace set from workstring
            bb := FindNextSetBegin(workstr,1); // get the location of next brace set
          end;
         //showmessage(inttostr(bb));
      until bb = 0; // no more braces
      if length(workstr) ‹› 0 then // more keys to send after last brace set, so send 'em
         sendkeys(workstr,targethwnd);
    end
  else
    begin // no braces, just send the string!
      sendkeys(workstr, targethwnd);
    end;
end;

/// Simulates a keystroke by pressing then releasing virtual key
procedure keystroke( key : byte);
begin
  simulatekeydown(key);
  simulatekeyup(key);
end;

// Procedure used by SendKeysEx. Should not need to be called by any user
// function.
procedure sendinbraces(s : string; targethwnd : hwnd);
var dashpos : integer;
    predash,postdash : string;
begin
  s := trim(s);
  dashpos := pos('-',s);
  if dashpos › 0 then
    begin
         predash := uppercase(copy(s,1,dashpos-1));
         postdash := copy(s,dashpos+1,length(s));
         if predash = 'ALT' then
            begin
              SetForegroundWindow(targetHwnd);
              simulatekeydown(vk_Menu);
              sendkeys(postdash,targethwnd);
              simulatekeyup(vk_Menu);
            end;
         if predash = 'CTRL' then
            begin
              SetForegroundWindow(targetHwnd);
              simulatekeydown(vk_Control);
              sendkeys(postdash,targethwnd);
              simulatekeyup(vk_Control);
            end;
         if predash = 'SHIFT' then
            begin
              SetForegroundWindow(targetHwnd);
              simulatekeydown(vk_shift);
              sendkeys(postdash,targethwnd);
              simulatekeyup(vk_shift);
            end;
    end
  else
    begin // simulate single keypresses
       s:= uppercase(s);
       SetForegroundWindow(targetHwnd);
       if s = 'ALTDOWN' then simulatekeydown(vk_Menu);
       if s = 'ALTUP' then simulatekeyup(vk_menu);
       if s = 'CTRLDOWN' then simulatekeydown(vk_control);
       if s = 'CTRLUP' then simulatekeyup(vk_control);
       if s = 'SHIFTDOWN' then simulatekeydown(vk_shift);
       if s = 'SHIFTUP' then simulatekeyup(vk_shift);
       if s = 'F1' then keystroke(vk_F1);
       if s = 'F2' then keystroke(vk_F2);
       if s = 'F3' then keystroke(vk_F3);
       if s = 'F4' then keystroke(vk_F4);
       if s = 'F5' then keystroke(vk_F5);
       if s = 'F6' then keystroke(vk_F6);
       if s = 'F7' then keystroke(vk_F7);
       if s = 'F8' then keystroke(vk_F8);
       if s = 'F9' then keystroke(vk_F9);
       if s = 'F10' then keystroke(vk_F10);
       if s = 'F11' then keystroke(vk_F11);
       if s = 'F12' then keystroke(vk_F12);
       if s = 'LEFT' then keystroke(vk_left);
       if s = 'RIGHT' then keystroke(vk_right);
       if s = 'UP' then keystroke(vk_up);
       if s = 'DOWN' then keystroke(vk_down);
       if s = 'HOME' then keystroke(vk_home);
       if s = 'END' then keystroke(vk_end);
       if s = 'NUMLOCK' then keystroke(vk_NumLock);
       if s = 'DELETE' then keystroke(vk_Delete);
       if s = 'DEL' then keystroke(vk_Delete);
       if s = 'INS' then keystroke(vk_Insert);
       if s = 'INSERT' then keystroke(vk_Insert);
    end;
end;

//*******************************************************************
// FINDAWINDOW - Searches a Windows List in order to locate a window
// with the specified title. If Partial is true, match doesn't need to
// be the exact title. If partial is false, the given title must match
// the window title exactly. The WList parameter is the Window list declared
// in the calling form. This procedure requires the WINDOWLIST unit,
// available from www.torry.ru
//********************************************************************
Function FindaWindow(title : string; partial : boolean; wlist :
TWindowList): hwnd;
var winnum : integer;
    foundit : boolean;
begin
  wlist.refresh;  // refresh the windows list
  winnum := 0;      // initialize counter
  foundit := false;
  if not partial then
   begin
    repeat
     if uppercase(wlist.windows[winnum].wincaption) = uppercase(title)
     then
       begin
         foundit := true;
         //result := wlist.windows[winnum].winhandle;
       end
     else
       begin
         inc(winnum)
       end;
    until foundit or (winnum = (wlist.count-1));
   end
  else  // partial title search
   begin
    repeat
     if isinstring(uppercase(title),uppercase(wlist.windows[winnum].wincaption))
     then
       begin
         foundit := true;
       end
     else
       begin
         inc(winnum)
       end;
    until foundit or (winnum = (wlist.count-1));
   end;
   if not foundit then
      result := 0   //return 0 if no window matched
   else
      result := wlist.windows[winnum].winhandle;
 end;
end.

 
 
 
 
© All rights reserved 1999 BuyPin Software