Wie Hotkey aus THotkey an Anwendung senden?

[Mazel]

Hallo,

ich habe auf meiner Form ein THotkey. Nun wenn man dort als Beispiel STRG+A eingibt, soll dieser Hotkey auch an ein Programm, von dem ich das Handle habe, gesendet werden.

Ich habe es mit:

Delphi-Quellcode:

 SendMessage(Wnd, WM_KEYDOWN, Hotkey1.Hotkey, 0)

versucht, aber leider hat dies nicht geklappt.

Wie kann ich das lösen?

Gruß
Mazel

[Berni68]

Hallo,

mit der unit sdnkey32 kann man eine beliebige Anwendung ansprechen und Tastaturanschläge an sie senden.
Die Unit sdnkey32 ist in Delphi in eimen Unterverzeichnis dabei.

Im Programm sieht das dann etwa so aus:
AppActivate(PChar('Anfang Festertitel von meinem Programm'));
SendKeys('F10', false);

Vielleicht kannst du damit was anfangen.

Und hier eine modifizierte (von diversen Stellen zusammenkopierte) Version von sdnkey32:

Delphi-Quellcode:

(*
SendKeys routine for 32-bit Delphi.

Written by Ken Henderson

Copyright (c) 1995 Ken Henderson     email:[e-mail]

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 FindAWindow(WinCaption: string; WinClassName: string): THandle;
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.
}

type
  PFindWindowStruct = ^TFindWindowStruct;
  TFindWindowStruct = record
    Caption: string;
    ClassName: String;
    WindowHandle: THandle;
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 Pos(PChar(lParam), WindowName)>0
    then Result:= true
    else Result:= false;
  If Result then WindowHandle:=WHandle;
end;
}

function EnumWindowsProc(hWindow: hWnd; lParam: LongInt): boolean; stdcall;
var
  lpBuffer: PChar;
  WindowCaptionFound: boolean;
  ClassNameFound: boolean;
begin
  GetMem(lpBuffer, 255);
  result:=true;
  WindowCaptionFound:=false;
  ClassNameFound:=false;
  try
    if GetWindowText(hWindow, lpBuffer,255)>0 then
      if Pos(PFindWindowStruct(lParam).Caption, StrPas(lpBuffer))>0
      then WindowCaptionFound:=true;
    if PFindWindowStruct(lParam).ClassName='' then
      ClassNameFound:=true
      else if GetClassName(hWindow, lpBuffer, 255)>0 then
        if Pos(PFindWindowStruct(lParam).ClassName, StrPas(lpBuffer))>0
        then ClassNameFound:=true;
    if (WindowCaptionFound and ClassNameFound) then begin PFindWindowStruct(lParam).WindowHandle:=hWindow; result:=false; end;
  finally
    FreeMem(lpBuffer, sizeof(lpBuffer^));
  end;
end;

function FindAWindow(WinCaption: string; WinClassName: string): THandle;
var
  WindowInfo: TFindWindowStruct;
begin
  with WindowInfo do begin
    caption := WinCaption;
    className := WinClassName;
    WindowHandle := 0;
    EnumWindows(@EnumWindowsProc, LongInt(@WindowInfo));
    result := WindowHandle;
  end;
end;

function AppActivate(WindowName: PChar): boolean;
begin
  try
    Result:=true;
//    WindowHandle:=FindWindow(nil,WindowName);
    WindowHandle:=FindAWindow(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); //auskommentiert
      SendMessage(WindowHandle, WM_SYSCOMMAND, SC_DEFAULT, WindowHandle);   // durch SC_DEFAULT ersetzt b.sch
      SetForegroundWindow(WindowHandle);  // hinzugefügt b.sch
    end else Result:=false;
  except
    on Exception do Result:=false;
  end;
end;

end.

[Mazel]

Hi,

danke. :)

Ich werde mir die Unit mal anschauen und suchen, ob ich die ganze Unit verwenden muss oder ob es reicht nur ein paar Teile zu verwenden.

Ich würde es gerne mit SendMessage machen, Problem dabei ist aber, die Modifiers zu senden, ein einzelner Key funktioniert.

Gruß
Mazel

[Mazel]

Guten Morgen,

@Bernie68:
Leider scheint es die sdnkey32 Unit nicht bei mir zu geben. Ich muss sagen das ich den Inhalt der Unit hier nicht richtig verstehe, ist ziemlich komplex.

Ich habe jetzt folgenden Code mir zusammengebaut aber leider funktiniert dies auch nicht.

Delphi-Quellcode:

ShortCutToKey(HotKey1.Hotkey, Key, Shift);
If ssCtrl in Shift then Modifiers := MOD_CONTROL;
If ssAlt in Shift then Modifiers := Modifiers or MOD_ALT;
If ssShift in Shift then Modifiers := Modifiers or MOD_SHIFT;
SendMessage(Wnd, WM_KEYDOWN, Hi(Modifiers), Key);

Weis jemand warum das nicht funktioniert? Ich habe es bei vielen Programmen versucht aber leider ohne Erfolg.

Gruß
Mazel

[Mazel]

Mein letzter, verzweifelter Versuch, jemand zu finden der eine Lösung hat oder einen Vorschlag machen könnte.

Gruß
Mazel

[Jenszen]

Am einfachsten kopierst Du die SndKey32.pas in dein Quellverzeichnis (und packst es natürlich auch unter uses.. in deine unit).

Die Sondertasten sind mit geschweiften Klammern zu umschließen (siehe SndKey32), etwa so:

SendKeys({F10}, false);

[DaniOne]

Kann jemand dazu eventuell mal ein beispiel reinstellen wie ich einem anderen Programm den F5 Befehl schicke???

Das was Jenszen geschrieben hat klappt bei mir leider nicht.

Das wär echt super denn ich blick da einfach noch nicht durch...mangels Beispielen.

[Mazel]

Erstmal hallo und herzlich willkommen in der DP :)

Zum Problem: ich habe das Thema aufgemacht, weil das Senden eines Hotkeys aus mehreren Zeichen wohl nicht einfach ist, aber ein F5 oder A etc. ist kein Problem. Der Code dafür ist vollgendermaßen:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var
  Hwnd: THandle;

begin
  Hwnd := 0;
  // Handle des Fensters finden
  Hwnd := FindWindow(nil, PChar('Titel'));
  // hier weist du, dass die Nachricht abgearbeitet wurde
  // SendMessage(Hwnd, WM_KEYDOWN, VK_F5, 0);
  // gibt kein Hinweis ob dass Programm reagiert hat
  PostMessage(Hwnd, WM_KEYDOWN, VK_F5, 0);
end;

Ich habe jetzt PostMessage verwendet, da ich mit dem Internet Explorer getestet habe. Bei mir reagiert er nicht über SendMessage.

Gruß
Mazel

[DaniOne]

Dankeschön!

Also es tut mir leid ich weiß echt nicht was ich falsch mache aber es funktioniert leider einfach nicht...

Ich habe also einen Timer(Intervall 10000) und er soll halt jedesmal beim Timer Ereignis diese Seite refreshen(F5)...in dem fall jetzt als Beispiel Google...es passiert aber rein gar nichts!

Delphi-Quellcode:

procedure TFrmBot.TmrRefreshTimer(Sender: TObject);
var Hwnd: THandle;
begin
 Title:=PChar('Google - Mozilla Firefox');
 Hwnd := 0;
 Hwnd := FindWindow(nil, PChar(Title));
 SendMessage(Hwnd, WM_KEYDOWN, VK_F5, 0);
end;

Danke schonmal für eure Hilfe

[Mazel]

Wo ist Title deklariert? Hast du es mal mit PostMessage probiert? Stimmt der Titel? Alles Dinge, die fehlerhafitg sein könnten.