Эмуляция нажатия клавиши для любого активного приложения

Советы » Буфер обмена » Эмуляция нажатия клавиши для любого активного приложения

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Эмуляция нажатия клавиши

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

Зависимости: SysUtils, Windows, messages
Автор:       VID, vidsnap@mail.ru, ICQ:132234868, Махачкала
Copyright:   Автор неизвестен
Дата:        19 июня 2002 г.
***************************************************** }

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

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com