1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145: 146: 147: 148: 149: 150: 151: 152: 153: 154: 155: 156: 157: 158: 159: 160: 161: 162: 163: 164: 165: 166: 167: 168: 169: 170: 171: 172: 173: 174: 175: 176: 177: 178: 179: 180: 181: 182: 183: 184: 185: 186: 187: 188: 189: 190: 191: 192: 193: 194: 195: 196: 197: 198: 199: 200: 201: 202: 203: 204: 205: 206: 207: 208: 209: 210: 211: 212: 213: 214: 215: 216: 217: 218: 219: 220: 221: 222: 223: 224: 225: 226: 227: 228: 229: 230: 231: 232: 233: 234: 235: 236: 237: 238: 239: 240: 241: 242: 243: 244: 245: 246: 247: 248: 249: 250: 251: 252: 253: 254: 255: 256: 257: 258: 259: 260: 261: 262: 263: 264: 265: 266: 267: 268: 269: 270: 271: 272: 273: 274: 275: 276: 277: 278: 279: 280: 281: 282: 283: 284: 285: 286: 287: 288: 289: 290: 291: 292: 293: 294: 295: 296: 297: 298: 299: 300: 301: 302: 303: 304: 305: 306: 307: 308: 309: 310: 311: 312: 313: 314: 315: 316: 317: 318: 319: 320: 321: 322: 323: 324: 325: 326: 327: 328: 329: 330: 331: 332: 333: 334: 335: 336: 337: 338: 339: 340: 341: 342: 343: 344: 345: 346: 347: 348: 349: 350: 351: 352: 353: 354: 355: 356: 357: 358: 359: 360: 361: 362: 363: 364: 365: 366: 367: 368: 369: 370: 371: 372: 373: 374: 375: 376: 377: 378: 379: 380: 381: 382:
| 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;
Function SendKeys(SendKeysString : PChar; Wait : Boolean) : Boolean; type WBytes = array[0..pred(SizeOf(Word))] of Byte;
TSendKey = record Name : ShortString; VKey : Byte; end;
const
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) );
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, VK_Next, VK_Insert, VK_Delete];
const INVALIDKEY = $FFFF ; 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;
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;
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
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. |