(*
SendKeys routine for 32-bit Delphi.

Written by Ken Henderson

Copyright (c) 1995 Ken Henderson

This unit includes two routines that simulate popular Visual Basic
routines: Sendkeys and AppActivate.  SendKeys takes a PWideChar
as its first parameter and a boolean as its second, like so:

SendKeys('KeyString', Wait);

where KeyString is a string of key names and modifiers that you want
to send to the current input focus and Wait is a boolean variable or value
that indicates whether SendKeys should wait for each key message to be
processed before proceeding.  See the table below for more information.

AppActivate also takes a PWideChar as its only parameter, like so:

AppActivate('WindowName');

where WindowName is the name of the window that you want to make the
current input focus.

SendKeys supports the Visual Basic SendKeys syntax, as documented below.

Supported modifiers:

+ = Shift
^ = Control
% = Alt
# = WinKey

Surround sequences of characters or key names with parentheses in order to
modify them as a group.  For example, '+abc' shifts only 'a', while '+(abc)' shifts
all three characters.

Supported special characters

~ = Enter
( = Begin modifier group (see above)
) = End modifier group (see above)
{ = Begin key name text (see below)
} = End key name text (see below)

Supported characters:

Any character that can be typed is supported.  Surround the modifier keys
listed above with braces in order to send as normal text.

Supported key names (surround these with braces):

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

Follow the keyname with a space and a number to send the specified key a
given number of times (e.g., {left 6}).
*)

unit Unit_SendKeys;

interface

Uses SysUtils, Windows, Messages;
procedure SendKeys(const SendKeysString : string;const Wait : Boolean;const IsPureText:Boolean=false);
function AppActivate(WindowName : PWideChar) : boolean;

procedure SendKeysByMessage(const SendKeyString:string);
procedure SendKeysByKbdEvent(const SendKeysString:PWideChar; const Wait:Boolean; const IsPureText:Boolean);

{Buffer for working with PWideChar's}

const
  WorkBufLen = 40;
var
  WorkBuf : array[0..WorkBufLen] of Char;

implementation


procedure SendKeys(const SendKeysString : string;const Wait : Boolean; const IsPureText:Boolean=false);
const
    strReturn:string=#13#10;
    strEnter:string=#13;
var
    buffer:string;
begin
    buffer:=StringReplace(SendKeysString,strReturn,strEnter,[rfReplaceAll]);

    //if IsPureText then begin
    //    SendKeysByMessage(buffer);
    //end else begin
        SendKeysByKbdEvent(PWideChar(buffer),Wait,IsPureText);
    //end;
end;

procedure SendKeysByMessage(const SendKeyString:string);
var
    i:integer;
    focushld,windowhld:hwnd;
    threadld:dword;
    ch: word;
begin
  windowhld:=GetForegroundWindow;
    //获得前台应用程序的活动窗口的句柄
  threadld:=GetWindowThreadProcessId(Windowhld,nil);
    //获取与指定窗口关联在一起的一个进程和线程标识符
  AttachThreadInput(GetCurrentThreadId,threadld,true);
    //通常，系统内的每个线程都有自己的输入队列。          //
    //AttachThreadInput允许线程和进程共享输入队列。        //
    //连接了线程后，输入焦点、窗口激活、鼠标捕获、键盘状态 //
    //以及输入队列状态都会进入共享状态          //
  Focushld:=getfocus;
    //获得拥有输入焦点的窗口的句柄
  AttachThreadInput(GetCurrentThreadId,threadld,false);
  //if focushld = 0 then Exit;
    //如果没有输入焦点则退出发送过程
  i := 1;
  while i <= Length(SendKeyString) do begin    //该过程发送指定字符串（中英文皆可以）
    ch := Word(SendKeyString[ i ]);
    SendMessage(focushld, WM_IME_CHAR, word(ch), 0);
    Inc(i);
  end;
end;


type
  THKeys = array[0..pred(MaxLongInt)] of byte;
var
  AllocationSize : integer;

(*
Converts a string of characters and key names to keyboard events and
passes them to Windows.

Example syntax:

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

*)

procedure SendKeysByKbdEvent(const SendKeysString:PWideChar; const Wait:Boolean; const IsPureText:Boolean);
type
  WBytes = array[0..pred(SizeOf(Word))] of Byte;

  TSendKey = record
    Name : ShortString;
    VKey : Byte;
  end;

const
  {Array of keys that SendKeys recognizes.

  If you add to this list, you must be sure to keep it sorted alphabetically
  by Name because a binary search routine is used to scan it.}

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

  {Extra VK constants missing from Delphi's Windows API interface}
  VK_NULL=0;
  VK_WinKey=91;         {Added by MJ PC Lab}
  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, WinKeyDown, FoundClose : Boolean;
  PosSpace : Byte;
  I, L : Integer;
  NumTimes, MKey : Word;
  KeyString : String[20];

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

function BitSet(BitTable, BitMask : Byte) : Boolean;
begin
  Result:=ByteBool(BitTable and BitMask);
end;

procedure SetBit(var BitTable : Byte; BitMask : Byte);
begin
  BitTable:=BitTable or Bitmask;
end;

Procedure KeyboardEvent(VKey, ScanCode : Byte; Flags : Longint);
var
  KeyboardMsg : TMsg;
begin
  keybd_event(VKey, ScanCode, Flags,0);
  If (Wait) then While (PeekMessage(KeyboardMsg,0,WM_KEYFIRST, WM_KEYLAST, PM_REMOVE)) do begin
    TranslateMessage(KeyboardMsg);
    DispatchMessage(KeyboardMsg);
  end;
end;

Procedure SendKeyDown(VKey: Byte; NumTimes : Word; GenUpMsg : Boolean);
var
  Cnt : Word;
  ScanCode : Byte;
  NumState : Boolean;
  KeyBoardState : TKeyboardState;
begin
  If (VKey=VK_NUMLOCK) then begin
    NumState:=ByteBool(GetKeyState(VK_NUMLOCK) and 1);
    GetKeyBoardState(KeyBoardState);
    If NumState then KeyBoardState[VK_NUMLOCK]:=(KeyBoardState[VK_NUMLOCK] and not 1)
    else KeyBoardState[VK_NUMLOCK]:=(KeyBoardState[VK_NUMLOCK] or 1);
    SetKeyBoardState(KeyBoardState);
    exit;
  end;

  ScanCode:=Lo(MapVirtualKey(VKey,0));
  For Cnt:=1 to NumTimes do
    If (VKey in ExtendedVKeys)then begin
      KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY);
      If (GenUpMsg) then
        KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP)
    end else begin
      KeyboardEvent(VKey, ScanCode, 0);
      If (GenUpMsg) then KeyboardEvent(VKey, ScanCode, KEYEVENTF_KEYUP);
    end;
end;

Procedure SendKeyUp(VKey: Byte);
var
  ScanCode : Byte;
begin
  ScanCode:=Lo(MapVirtualKey(VKey,0));
  If (VKey in ExtendedVKeys)then
    KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY and KEYEVENTF_KEYUP)
  else KeyboardEvent(VKey, ScanCode, KEYEVENTF_KEYUP);
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;

{Implements a simple binary search to locate special key name strings}

Function StringToVKey(KeyString : ShortString) : Word;
var
  Found, Collided : Boolean;
  Bottom, Top, Middle : Byte;
begin
  Result:=INVALIDKEY;
  Bottom:=1;
  Top:=MaxSendKeyRecs;
  Found:=false;
  Middle:=(Bottom+Top) div 2;
  Repeat
    Collided:=((Bottom=Middle) or (Top=Middle));
    If (KeyString=SendKeyRecs[Middle].Name) then begin
       Found:=True;
       Result:=SendKeyRecs[Middle].VKey;
    end else begin
       If (KeyString>SendKeyRecs[Middle].Name) then Bottom:=Middle
       else Top:=Middle;
       Middle:=(Succ(Bottom+Top)) div 2;
    end;
  Until (Found or Collided);
  //If (Result=INVALIDKEY) then DisplayMessage('Invalid Key Name');
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);
    if WinKeyDown then SendKeyUp(VK_WinKey);
    
    ShiftDown:=false;
    ControlDown:=false;
    AltDown:=false;
    WinKeyDown:=false;
  end;
end;

begin
  AllocationSize:=MaxInt;
  UsingParens:=false;
  ShiftDown:=false;
  ControlDown:=false;
  AltDown:=false;
  WinKeyDown:=false;
  I:=0;
  L:=StrLen(SendKeysString);
  If (L>AllocationSize) then L:=AllocationSize;
  If (L=0) then Exit;

  if IsPureText then begin
    for I := 0 to L - 1 do begin

        if I mod 500=0 then sleep(500);

        MKey:=vkKeyScan(SendKeysString[I]);
        //If (MKey<>INVALIDKEY) then begin
            SendKey(MKey,1,True);
        //end;
    end;
  end else begin
    While (I<L) do begin
        case SendKeysString[I] of
        '(' : begin
                UsingParens:=True;
                Inc(I);
              end;
        ')' : begin
                UsingParens:=False;
                PopUpShiftKeys;
                Inc(I);
              end;
        '^' :  begin
                 ControlDown:=True;
                 SendKeyDown(VK_CONTROL,1,False);
                 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
                 WinKeyDown:=True;
                 SendKeyDown(VK_WinKey,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(Char(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('Invalid KeyName');
                 Inc(I);
              end;
        end;

        if I mod 500=0 then sleep(500);
    end;
  end;

  PopUpShiftKeys;
end;

{AppActivate

This is used to set the current input focus to a given window using its
name.  This is especially useful for ensuring a window is active before
sending it input messages using the SendKeys function.  You can specify
a window's name in its entirety, or only portion of it, beginning from
the left.

}


var
  WindowHandle : HWND;

function EnumWindowsProc(WHandle: HWND; lParam: LPARAM): BOOL; export; stdcall;
var
  WindowName : array[0..MAX_PATH] of char;
begin
  {Can't test GetWindowText's return value since some windows don't have a title}
  GetWindowText(WHandle,WindowName,MAX_PATH);
  Result := (StrLIComp(WindowName,PWideChar(lParam), StrLen(PWideChar(lParam))) <> 0);
  If (not Result) then WindowHandle:=WHandle;
end;

function AppActivate(WindowName : PWideChar) : boolean;
begin
  try
    Result:=true;
    WindowHandle:=FindWindow(nil,WindowName);
    If (WindowHandle=0) then EnumWindows(@EnumWindowsProc,Integer(PWideChar(WindowName)));
    If (WindowHandle<>0) then begin
      SendMessage(WindowHandle, WM_SYSCOMMAND, SC_HOTKEY, WindowHandle);
      SendMessage(WindowHandle, WM_SYSCOMMAND, SC_RESTORE, WindowHandle);
      SetForegroundWindow(WindowHandle);
    end else Result:=false;
  except
    on Exception do Result:=false;
  end;
end;

end.