"Presionar" teclas programáticamente

dec · #1 01-07-2006

Código Delphi [-]unit sndkey;

interface

Uses
  SysUtils, Windows, Messages;

Function SendKeys(SendKeysString : String) : Boolean;

implementation

(*
 Envia un string de caracteres, incluyendo nombres de teclas y
 presiona las teclas por el usuario desde tu programa.

Teclas especiles:
+ = Shift
^ = Control
% = Alt
~ = Enter

Nombres de teclas soportadas:
Obs.: Los nombres de las teclas deben ser colocados entre llaves.

BKSP, BS, BACKSPACE
BREAK
CAPSLOCK
CLEAR
DEL
DELETE
DOWN
END
ENTER
ESC
ESCAPE
F1
F2
F3
F4
F5
F6
F7
F8
F9
F10
F11
F12
F13
F14
F15
F16
HELP
HOME
INS
LEFT
NUMLOCK
PGDN
PGUP
PRTSC
RIGHT
SCROLLLOCK
TAB
UP

Para repetir uma misma tecla várias veces, basta colocar su nombre
seguido de espacio y el número de vezes que quisieras repetir.
Por ex.: {left 6}.

Sintaxis:

SendKeys('abc123{left}{left}{left}def{end}456{left 6}ghi{end}789');

Ejemplo de uso:

// añadir la unit ShellAPI en uses;
WinExec('Notepad.exe',1);
SendKeys('Hola desde {CAPSLOCK}d{CAPSLOCK}elphi');

*)

Function SendKeys(SendKeysString : String) : Boolean;
type
  WBytes = array[0..pred(SizeOf(Word))] of Byte;

  TSendKey = record
    Nome : String;
    VTecla : Byte;
  end;

const
  MaxSendKeyRecs = 41;
  SendKeyRecs : array[1..MaxSendKeyRecs] of TSendKey =
  (
   (Nome:'BKSP';            VTecla:VK_BACK),
   (Nome:'BS';              VTecla:VK_BACK),
   (Nome:'BACKSPACE';       VTecla:VK_BACK),
   (Nome:'BREAK';           VTecla:VK_CANCEL),
   (Nome:'CAPSLOCK';        VTecla:VK_CAPITAL),
   (Nome:'CLEAR';           VTecla:VK_CLEAR),
   (Nome:'DEL';             VTecla:VK_DELETE),
   (Nome:'DELETE';          VTecla:VK_DELETE),
   (Nome:'DOWN';            VTecla:VK_DOWN),
   (Nome:'END';             VTecla:VK_END),
   (Nome:'ENTER';           VTecla:VK_RETURN),
   (Nome:'ESC';             VTecla:VK_ESCAPE),
   (Nome:'ESCAPE';          VTecla:VK_ESCAPE),
   (Nome:'F1';              VTecla:VK_F1),
   (Nome:'F2';              VTecla:VK_F2),
   (Nome:'F3';              VTecla:VK_F3),
   (Nome:'F4';              VTecla:VK_F4),
   (Nome:'F5';              VTecla:VK_F5),
   (Nome:'F6';              VTecla:VK_F6),
   (Nome:'F7';              VTecla:VK_F7),
   (Nome:'F8';              VTecla:VK_F8),
   (Nome:'F9';              VTecla:VK_F9),
   (Nome:'F10';             VTecla:VK_F10),
   (Nome:'F11';             VTecla:VK_F11),
   (Nome:'F12';             VTecla:VK_F12),
   (Nome:'F13';             VTecla:VK_F13),
   (Nome:'F14';             VTecla:VK_F14),
   (Nome:'F15';             VTecla:VK_F15),
   (Nome:'F16';             VTecla:VK_F16),
   (Nome:'HELP';            VTecla:VK_HELP),
   (Nome:'HOME';            VTecla:VK_HOME),
   (Nome:'INS';             VTecla:VK_INSERT),
   (Nome:'LEFT';            VTecla:VK_LEFT),
   (Nome:'NUMLOCK';         VTecla:VK_NUMLOCK),
   (Nome:'PGDN';            VTecla:VK_NEXT),
   (Nome:'PGUP';            VTecla:VK_PRIOR),
   (Nome:'PRTSC';           VTecla:VK_PRINT),
   (Nome:'RIGHT';           VTecla:VK_RIGHT),
   (Nome:'SCROLLLOCK';      VTecla:VK_SCROLL),
   (Nome:'TAB';             VTecla:VK_TAB),
   (Nome:'UP';              VTecla:VK_UP)
  );

  {Códigos extras de interface API do Windows}
  VK_NULL=0;
  VK_SemiColon=186;
  VK_Equal=187;
  VK_Comma=188;
  VK_Minus=189;
  VK_Period=190;
  VK_Slash=191;
  VK_BackQuote=192;
  VK_LeftBracket=219;
  VK_BackSlash=220;
  VK_RightBracket=221;
  VK_Quote=222;
  VK_Last=VK_Quote;

  ExtendedVKeys : set of byte =
  [VK_Up,
   VK_Down,
   VK_Left,
   VK_Right,
   VK_Home,
   VK_End,
   VK_Prior,  {PgUp}
   VK_Next,   {PgDn}
   VK_Insert,
   VK_Delete];

const
  INVALIDKEY = $FFFF {Unsigned -1};
  VKKEYSCANSHIFTON = $01;
  VKKEYSCANCTRLON = $02;
  VKKEYSCANALTON = $04;
  UNITNAME = 'SendKeys';
var
  UsingParens, ShiftDown, ControlDown, AltDown, FoundClose : Boolean;
  VKey,PosSpace : Byte;
  I, L, NumTimes, MKey : Word;
  KeyString : String[20];

procedure DisplayMessage(Message : String);
begin
  MessageBox(0,PChar(Message),UNITNAME,0);
end;

function BitSet(BitTable, BitMask : Byte) : Boolean;
{  inline($5A/$58/$20/$D0/$74/$02/$B0/$01);}
begin
  Result:=Boolean(BitTable and BitMask);
end;

procedure SetBit(var BitTable : Byte; BitMask : Byte);
{  inline($58/$5F/$07/$26/$08/$05);}
begin
  BitTable:=BitTable or Bitmask;
end;

Procedure SendKeyDown(VKey: Byte; NumTimes : Word; GenUpMsg : Boolean);
var
  Cnt : Word;
  ScanCode : Byte;
begin
  ScanCode:=Lo(MapVirtualKey(VKey,0));
  For Cnt:=1 to NumTimes do
    If (VKey in ExtendedVKeys)then begin
      keybd_event(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY,0);
      If (GenUpMsg) then
        keybd_event(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0)
    end else begin
      keybd_event(VKey, ScanCode, 0 ,0);
      If (GenUpMsg) then keybd_event(VKey, ScanCode, KEYEVENTF_KEYUP,0);
    end;
end;

Procedure SendKeyUp(VKey: Byte);
var
  ScanCode : Byte;
begin
  ScanCode:=Lo(MapVirtualKey(VKey,0));
  If (VKey in ExtendedVKeys)then
    keybd_event(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY and KEYEVENTF_KEYUP, 0)
  else keybd_event(VKey, ScanCode, KEYEVENTF_KEYUP,0);
end;

Procedure SendKey(MKey: Word; NumTimes : Word; GenDownMsg : Boolean);
begin
  If (BitSet(Hi(MKey),VKKEYSCANSHIFTON)) then SendKeyDown(VK_SHIFT,1,False);
  If (BitSet(Hi(MKey),VKKEYSCANCTRLON)) then SendKeyDown(VK_CONTROL,1,False);
  If (BitSet(Hi(MKey),VKKEYSCANALTON)) then SendKeyDown(VK_MENU,1,False);
  SendKeyDown(Lo(MKey), NumTimes, GenDownMsg);
  If (BitSet(Hi(MKey),VKKEYSCANSHIFTON)) then SendKeyUp(VK_SHIFT);
  If (BitSet(Hi(MKey),VKKEYSCANCTRLON)) then SendKeyUp(VK_CONTROL);
  If (BitSet(Hi(MKey),VKKEYSCANALTON)) then SendKeyUp(VK_MENU);
end;

{busca binária para localizar nomes de teclas especiais}

Function StringToVKey(KeyString : String) : Word;
var
  Found, Collided : Boolean;
  Index : Byte;
  Bottom, Top, Middle : Byte;
begin
  Found:=false;
  Result:=INVALIDKEY;
  Bottom:=1;
  Top:=MaxSendKeyRecs;
  Found:=false;
  Collided:=false;
  Middle:=(Bottom+Top) div 2;
  Repeat
    Collided:=((Bottom=Middle) or (Top=Middle));
    If (KeyString=SendKeyRecs[Middle].Nome) then begin
       Found:=True;
       Result:=SendKeyRecs[Middle].VTecla;
    end else begin
       If (KeyString>SendKeyRecs[Middle].Nome) then Bottom:=Middle
       else Top:=Middle;
       Middle:=(Succ(Bottom+Top)) div 2;
    end;
  Until (Found or Collided);
  If (Result=INVALIDKEY) then DisplayMessage('Tecla inválida');
end;

procedure PopUpShiftKeys;
begin
  If (not UsingParens) then begin
    If ShiftDown then SendKeyUp(VK_SHIFT);
    If ControlDown then SendKeyUp(VK_CONTROL);
    If AltDown then SendKeyUp(VK_MENU);
    ShiftDown:=false;
    ControlDown:=false;
    AltDown:=false;
  end;
end;

begin
  Result:=false;
  UsingParens:=false;
  ShiftDown:=false;
  ControlDown:=false;
  AltDown:=false;
  I:=1;
  L:=Length(SendKeysString);
  If (L=0) then Exit;
  While (I<=L) do begin
    case SendKeysString[i] of
    '(' : begin
            UsingParens:=True;
            Inc(I);
          end;
    ')' : begin
            UsingParens:=False;
            PopUpShiftKeys;
            Inc(I);
          end;
    '%' : begin
             AltDown:=True;
             SendKeyDown(VK_MENU,1,False);
             Inc(I);
          end;
    '+' :  begin
             ShiftDown:=True;
             SendKeyDown(VK_SHIFT,1,False);
             Inc(I);
           end;
    '^' :  begin
             ControlDown:=True;
             SendKeyDown(VK_CONTROL,1,False);
             Inc(I);
           end;
    '{' : begin
            NumTimes:=1;
            If (SendKeysString[Succ(I)]='{') then begin
              MKey:=VK_LEFTBRACKET;
              SetBit(Wbytes(MKey)[1],VKKEYSCANSHIFTON);
              SendKey(MKey,1,True);
              PopUpShiftKeys;
              Inc(I,3);
              Continue;
            end;
            KeyString:='';
            FoundClose:=False;
            While (I<=L) do begin
              Inc(I);
              If (SendKeysString[i]='}') then begin
                FoundClose:=True;
                Inc(I);
                Break;
              end;
              KeyString:=KeyString+Upcase(SendKeysString[i]);
            end;
            If (Not FoundClose) then begin
               DisplayMessage('No Close');
               Exit;
            end;
            If (SendKeysString[i]='}') then begin
              MKey:=VK_RIGHTBRACKET;
              SetBit(Wbytes(MKey)[1],VKKEYSCANSHIFTON);
              SendKey(MKey,1,True);
              PopUpShiftKeys;
              Inc(I);
              Continue;
            end;
            PosSpace:=Pos(' ',KeyString);
            If (PosSpace<>0) then begin
               NumTimes:=StrToInt(Copy(KeyString,Succ(PosSpace),Length(KeyString)-PosSpace));
               KeyString:=Copy(KeyString,1,Pred(PosSpace));
            end;
            If (Length(KeyString)=1) then MKey:=vkKeyScan(KeyString[1])
            else MKey:=StringToVKey(KeyString);
            If (MKey<>INVALIDKEY) then begin
              SendKey(MKey,NumTimes,True);
              PopUpShiftKeys;
              Continue;
            end;
          end;
    '~' : begin
            SendKeyDown(VK_RETURN,1,True);
            PopUpShiftKeys;
            Inc(I);
          end;
    else  begin
             MKey:=vkKeyScan(SendKeysString[i]);
             If (MKey<>INVALIDKEY) then begin
               SendKey(MKey,1,True);
               PopUpShiftKeys;
             end else DisplayMessage('Nombre de tecla inválido');
             Inc(I);
          end;
    end;
  end;
  Result:=true;
  PopUpShiftKeys;
end;

end.

Neftali [Germán.Estévez] · #2 05-08-2014

Gracias a marconi por esta corrección al truco:

La función StringToVKey hace una búsqueda alfabética y para eso, SendKeyRecs debe estar ordenado o algunas teclas (como F10) no las encontrará.
La definición correcta de SendKeyRecs será:

Código Delphi [-]SendKeyRecs : array[1..MaxSendKeyRecs] of TSendKey =
  (
   (Nome:'BACKSPACE';       VTecla:VK_BACK),
   (Nome:'BKSP';            VTecla:VK_BACK),
   (Nome:'BREAK';           VTecla:VK_CANCEL),
   (Nome:'BS';              VTecla:VK_BACK),
   (Nome:'CAPSLOCK';        VTecla:VK_CAPITAL),
   (Nome:'CLEAR';           VTecla:VK_CLEAR),
   (Nome:'DEL';             VTecla:VK_DELETE),
   (Nome:'DELETE';          VTecla:VK_DELETE),
   (Nome:'DOWN';            VTecla:VK_DOWN),
   (Nome:'END';             VTecla:VK_END),
   (Nome:'ENTER';           VTecla:VK_RETURN),
   (Nome:'ESC';             VTecla:VK_ESCAPE),
   (Nome:'ESCAPE';          VTecla:VK_ESCAPE),
   (Nome:'F1';              VTecla:VK_F1),
   (Nome:'F10';             VTecla:VK_F10),
   (Nome:'F11';             VTecla:VK_F11),
   (Nome:'F12';             VTecla:VK_F12),
   (Nome:'F13';             VTecla:VK_F13),
   (Nome:'F14';             VTecla:VK_F14),
   (Nome:'F15';             VTecla:VK_F15),
   (Nome:'F16';             VTecla:VK_F16),
   (Nome:'F2';              VTecla:VK_F2),
   (Nome:'F3';              VTecla:VK_F3),
   (Nome:'F4';              VTecla:VK_F4),
   (Nome:'F5';              VTecla:VK_F5),
   (Nome:'F6';              VTecla:VK_F6),
   (Nome:'F7';              VTecla:VK_F7),
   (Nome:'F8';              VTecla:VK_F8),
   (Nome:'F9';              VTecla:VK_F9),
   (Nome:'HELP';            VTecla:VK_HELP),
   (Nome:'HOME';            VTecla:VK_HOME),
   (Nome:'INS';             VTecla:VK_INSERT),
   (Nome:'LEFT';            VTecla:VK_LEFT),
   (Nome:'NUMLOCK';         VTecla:VK_NUMLOCK),
   (Nome:'PGDN';            VTecla:VK_NEXT),
   (Nome:'PGUP';            VTecla:VK_PRIOR),
   (Nome:'PRTSC';           VTecla:VK_PRINT),
   (Nome:'RIGHT';           VTecla:VK_RIGHT),
   (Nome:'SCROLLLOCK';      VTecla:VK_SCROLL),
   (Nome:'TAB';             VTecla:VK_TAB),
   (Nome:'UP';              VTecla:VK_UP)
  );

elrayo76 · #3 14-11-2014

La función esta muy buena, pero tengo una duda. Porque se hizo todo dentro de una sola función, es decir, funciones dentro de la principal, type, constantes, etc.

No es lo mismo que hacer las funciones y todo lo demas fuera de la principal?.

Saludos,
El Rayo