Програмная эмуляция нажатия клавиш

Code:

{ **** UBPFD ***********  ****

>> Эмуляция нажатия клавиши

Функция SendKeys этого юнита, эмулиреут нажатие клавиши для лююого активного приложения

Для активизации приложения ивпользуйте функцию AppActivate

Зависимости: SysUtils, Windows, messages

Автор:       VID, Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра.,

***************************************************** }

unit SKUnit;

interface

uses SysUtils, Windows, messages;

function SendKeys(SendKeysString: PChar; Wait: Boolean): Boolean;

function AppActivate(WindowName: PChar): boolean;

const

WorkBufLen = 40;

var

WorkBuf: array[0..WorkBufLen] of Char;

implementation

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);

*)

function SendKeys(SendKeysString: PChar; Wait: Boolean): 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: 'BKSP'; VKey: VK_BACK),

   (Name: 'BS'; VKey: VK_BACK),

   (Name: 'BACKSPACE'; VKey: VK_BACK),

   (Name: 'BREAK'; VKey: VK_CANCEL),

   (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_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;

PosSpace: Byte;

I, L: Integer;

NumTimes, MKey: Word;

KeyString: string[20];

procedure DisplayMessage(Message: PChar);

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);

     ShiftDown := false;

     ControlDown := false;

     AltDown := false;

   end;

end;

begin

AllocationSize := MaxInt;

Result := false;

UsingParens := false;

ShiftDown := false;

ControlDown := false;

AltDown := false;

I := 0;

L := StrLen(SendKeysString);

if (L > AllocationSize) then

   L := AllocationSize;

if (L = 0) then

   Exit;

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('Invalid KeyName');

     Inc(I);

   end;

end;

Result := true;

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;

const

MAX_WINDOW_NAME_LEN = 80;

var

WindowName: array[0..MAX_WINDOW_NAME_LEN] of char;

begin

{Can't test GetWindowText's return value since some windows don't have a title}

GetWindowText(WHandle, WindowName, MAX_WINDOW_NAME_LEN);

Result := (StrLIComp(WindowName, PChar(lParam), StrLen(PChar(lParam))) <> 0);

if (not Result) then

   WindowHandle := WHandle;

end;

function AppActivate(WindowName: PChar): boolean;

begin

try

   Result := true;

   WindowHandle := FindWindow(nil, WindowName);

   if (WindowHandle = 0) then

     EnumWindows(@EnumWindowsProc, Integer(PChar(WindowName)));

   if (WindowHandle <> 0) then

   begin

     SendMessage(WindowHandle, WM_SYSCOMMAND, SC_HOTKEY, WindowHandle);

     SendMessage(WindowHandle, WM_SYSCOMMAND, SC_RESTORE, WindowHandle);

   end

   else

     Result := false;

except

   on Exception do

     Result := false;

end;

end;

end.

//Пример использования:

SendKeys('A', False);