Почти полный аналог метода SendKeys из VB

Советы » Клавиши » Почти полный аналог метода SendKeys из VB

(*
SendKeys routine for 32-bit Delphi.

Written by Ken Henderson

Copyright (c) 1995 Ken Henderson     email:khen@compuserve.com

This unit includes two routines that simulate popular Visual Basic
routines: Sendkeys and AppActivate.  SendKeys takes a PChar
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 PChar 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

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

sndkey32; interface

Uses

SysUtils, Windows, Messages; Function

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

AppActivate(WindowName : PChar) : boolean; {Buffer for working with PChar's} 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, Sca 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; while

(Ibegin 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

; 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

.

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

Категории

Статьи

Советы

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