Btgunluk.com

Delphi 10 Seattle'da Uygulamalara SendKeys ile Tuş Göndermek

Delphi'nin Unicode desteklemeyen önceki sürümlerinde, Delphi'nin cd'sinde yer alan şu unit ile uygulamara tuş gönderebiliyorduk. Ancak Unicode destekli güncel Delphi sürümlerinde bu unit derlenirken aşağıdaki ölümcül hataya neden oluyor:

Bu unit'in Delphi 10 Seattle'da çalışacak şekilde düzenlenmiş hali şurada yer alıyor. Başka uygulamaları yönetmekte çok kullanılışlı olan bu unit'i tarihin tozlu yapraklarına karışmaktan kurtarmak için aşağıya da aldım. Unit'i diske sndkey.pas adıyla kaydetmeniz gerektiğini hatırlatayım. Eski uygulamlarınızdaki Unicode uyumsuzluğunu gidermek için buraya bakabilirsiniz.

unit sndkey;

interface

uses
  SysUtils, Windows, Messages;

function SendKeys(SendKeysString: {$IFDEF UNICODE}PWideChar{$ELSE}PAnsiChar{$ENDIF}; Wait: Boolean): Boolean;

function AppActivate(WindowName: {$IFDEF UNICODE}PWideChar{$ELSE}PAnsiChar{$ENDIF}): 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: {$IFDEF UNICODE}PWideChar{$ELSE}PAnsiChar{$ENDIF}; 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 := VkKeyScanA(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:={$IFDEF UNICODE}VkKeyScanW{$ELSE}VkKeyScanA{$ENDIF}(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: {$IFDEF UNICODE}PWideChar{$ELSE}PAnsiChar{$ENDIF}): Boolean;
begin
  try
    Result := True;
    WindowHandle:= {$IFDEF UNICODE}FindWindowW{$ELSE}FindWindowA{$ENDIF}(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.

04.01.2017 10:48:10

Yorumlar