- 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, 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;
- 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('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.