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

Delphi , ОС и Железо , Клавиши

Автор: VID
WEB-сайт: http://delphibase.endimus.com

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

Привет! Вот перевод текста на русский язык:

Это модуль Delphi, который предоставляет две функции: SendKeys и AppActivate. Функция SendKeys позволяет симулировать ввод клавиш, отправляя конкретные нажатия клавиш в активное окно. Функция AppActivate активирует окно по его имени.

Вот подробный анализ кода:

SendKeys

Функция SendKeys принимает два параметра: SendKeysString, который является строкой, содержащей нажатия клавиш для отправки, и Wait, который определяет, должна ли функция ждать обработки нажатий клавиш перед возвращением. Функция использует алгоритм двоичного поиска, чтобы найти конкретные имена клавиш в строке ввода.

Код проходит через строку ввода, обрабатывая каждый символ следующим образом:

• Если символ является открывающим скобкой (, то функция устанавливает флаг, указывающий на то, что блок нажатий клавиш должен быть обработан.
• Если символ является закрывающей скобкой ), то функция обрабатывает блок нажатий клавиш и сбрасывает флаг.
• Если символ %, то функция симулирует нажатие кнопки Alt.
• Если символ +, то функция симулирует нажатие кнопки Shift.
• Если символ ^, то функция симулирует нажатие кнопки Ctrl.
• Если символ {, то функция обрабатывает блок нажатий клавиш и сбрасывает флаг.
• В противном случае функция симулирует соответствующее нажатие клавиши.

AppActivate

Функция AppActivate принимает один параметр: WindowName, который является именем окна, которое нужно активировать. Функция использует API-функцию FindWindow для поиска окна с указанным именем, или если это не удается, она перечисляет все окна с помощью callback-функции EnumWindowsProc.

Если окно найдено, функция отправляет два сообщения в окно: WM_ SYSCOMMAND с SC_HOTKEY, а затем WM_SYSCOMMAND с SC_RESTORE. Эти сообщения используются для активации окна и вывода его на передний план.

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

Вы можете использовать функцию SendKeys следующим образом:

SendKeys('A', False);

Это симулирует нажатие клавиши 'A'. Если вы хотите ждать обработки нажатия клавиш, установите второй параметр в True.

Аналогично, вы можете использовать функцию AppActivate следующим образом:

AppActivate('Notepad');

Это активирует окно Notepad, если оно существует.

Обратите внимание, что этот код является специфичным для Delphi и может не работать с другими языками программирования или средами. Кроме того, будьте осторожны при симулировании ввода клавиш или активации окон программно, так как это может представлять потенциальную угрозу безопасности.

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

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Клавиши ::