Probleme mit PostMessage(WM_KEYDOWN)

[EWeiss]

Zitat von Periander:

was für "uses" brauche ich dafür?
Er erkennt diese art von API nicht.

Teste das mal!

Delphi-Quellcode:

unit SendKeys;

interface

uses
  Windows, SysUtils;

const
  SK_BKSP = #8;
  SK_TAB = #9;
  SK_ENTER = #13;
  SK_ESC = #27;
  SK_ADD = #107;
  SK_SUB = #109;
  SK_F1 = #228;
  SK_F2 = #229;
  SK_F3 = #230;
  SK_F4 = #231;
  SK_F5 = #232;
  SK_F6 = #233;
  SK_F7 = #234;
  SK_F8 = #235;
  SK_F9 = #236;
  SK_F10 = #237;
  SK_F11 = #238;
  SK_F12 = #239;
  SK_HOME = #240;
  SK_END = #241;
  SK_UP = #242;
  SK_DOWN = #243;
  SK_LEFT = #244;
  SK_RIGHT = #245;
  SK_PGUP = #246;
  SK_PGDN = #247;
  SK_INS = #248;
  SK_DEL = #249;
  SK_SHIFT_DN = #250;
  SK_SHIFT_UP = #251;
  SK_CTRL_DN = #252;
  SK_CTRL_UP = #253;
  SK_ALT_DN = #254;
  SK_ALT_UP = #255;

procedure SendKeyString(Text: String);
procedure SendKeysToTitle(WindowTitle: String; Text: String);
procedure SendKeysToHandle(WindowHandle: hWnd; Text: String);
procedure MakeWindowActive(wHandle: hWnd);
function GetHandleFromWindowTitle(TitleText: String): hWnd;

implementation

procedure SendKeyString(Text: String);
var
   i: Integer;
   Shift: Boolean;
   vk, ScanCode: Word;
   ch: Char;
   c, s: Byte;
const
   vk_keys: Array[0..9] of Byte =
      (VK_HOME, VK_END, VK_UP, VK_DOWN, VK_LEFT,
       VK_RIGHT, VK_PRIOR, VK_NEXT, VK_INSERT, VK_DELETE);
   vk_shft: Array[0..2] of Byte = (VK_SHIFT, VK_CONTROL, VK_MENU);
   flags: Array[False..True] of Integer = (KEYEVENTF_KEYUP, 0);
begin
   Shift := False;
   for i := 1 to Length(Text) do
    begin
     ch := Text[i];
     if ch >= #250 then
      begin
       s := Ord(ch) - 250;
       Shift := not Odd(s);
       c := vk_shft[s shr 1];
       ScanCode := MapVirtualKey(c,0);
       Keybd_Event(c, Scancode, Flags[shift], 0);
      end
     else
      begin
       vk := 0;
       if ch >= #240 then
        c := vk_keys[Ord(ch) - 240]
       else
        if ch >= #228 then {228 (F1) => $70 (vk_F1)}
         c := Ord(ch) - 116
        else
         if ch < #110 then
          c := Ord(ch)
         else
          begin
           vk := VkKeyScan(ch);
           c := LoByte(vk);
          end;
       ScanCode := MapVirtualKey(c,0);
       if not Shift and (Hi(vk) > 0) then { $2A = scancode of VK_SHIFT }
        Keybd_Event(VK_SHIFT, $2A, 0, 0);
       Keybd_Event(c,scancode, 0, 0);
       Keybd_Event(c,scancode, KEYEVENTF_KEYUP, 0);
       if not Shift and (Hi(vk) > 0) then
        Keybd_Event(VK_SHIFT, $2A, KEYEVENTF_KEYUP, 0);
      end;
    end;
end;

procedure MakeWindowActive(wHandle: hWnd);
begin
  if IsIconic(wHandle) then
   ShowWindow(wHandle, SW_RESTORE)
  else
   BringWindowToTop(wHandle);
end;

function GetHandleFromWindowTitle(TitleText: String): hWnd;
var
  StrBuf: Array[0..$FF] of Char;
begin
  Result := FindWindow(PChar(0), StrPCopy(StrBuf, TitleText));
end;

procedure SendKeysToTitle(WindowTitle: String; Text: String);
var
  Window: hWnd;
begin
  Window := GetHandleFromWindowTitle(WindowTitle);
  MakeWindowActive(Window);
  SendKeyString(Text);
end;

procedure SendKeysToHandle(WindowHandle: hWnd; Text: String);
begin
  MakeWindowActive(WindowHandle);
  SendKeyString(Text);
end;

end.

gibts nicht die SNDKEY32.pas in Delphi?

gruß

[Periander]

ahh... das sieht schonmal ziemlich gut aus.
Werde damit erstmal noch ein bisschen rumprobieren.
Vielen dank für die schnelle Hilfe.

[EWeiss]

Zitat von Periander:

ahh... das sieht schonmal ziemlich gut aus.
Werde damit erstmal noch ein bisschen rumprobieren.
Vielen dank für die schnelle Hilfe.

Hier noch ne andere!

Delphi-Quellcode:

unit Sendkey;


interface

uses  WinTypes;

procedure SendKeys( h: HWND; const keys: string; wait: boolean );

implementation

uses WinProcs, Messages, SysUtils, Forms, Dialogs ;

type
  TWindowObj = class( TObject )
  private
    windowHandle : HWND;
    TargetClass : PChar;
    NameLength : Integer;
    Buffer : PChar;
  public
    constructor Create;
    destructor Destroy;
    procedure SetTargetClass( className : string );
    procedure SetWindowHandle( hWnd: HWND );
    function GetWindowHandle: hWnd;
    function Equal( handle: HWND ): boolean;

  end;

const
     OPENBRACE = '{';
     CLOSEBRACE = '}';
     PLUS = '+';
     CARET = '^';
     PERCENT = '%';
     SPACE = ' ';
     TILDE = '~';
     SHIFTKEY = $10;
     CTRLKEY = $11;
     ALTKEY = $12;
     ENTERKEY = $13;
     OPENPARENTHESES  = '(';
     CLOSEPARENTHESES = ')';
     NULL = #0;
     TargetControlClass = 'Edit';

{================ GetTextWindow =============================}
function  EnumChildProc( hWnd: HWND; lParam: LongInt ):Bool;export;
var
   continueFlg : boolean;
   HObj : TWindowObj;
begin
   HObj := TWindowObj( lParam );
   if HObj.Equal( hWnd ) then begin
      HObj.SetWindowHandle( hWnd );
      continueFlg := false;
   end;
   result := continueFlg;   { Stop Enumerate}
end;


function GetFocusWindow( h: HWnd ): hWnd;
{ GetFocus and if return 0 then search Edit Control in Children of the window}
var
   EnumFunc : TFarProc;
   Param : LongInt;
   proc: TFarProc;
   ok : Boolean;
   hObj :  TWindowObj;
   targetWindow : HWnd;

begin
   targetWindow := GetFocus;
   if targetWindow <> 0 then begin
      result := targetWindow;
      exit;
   end;
   h := GetActiveWindow;
   Proc := @EnumChildProc;
    EnumFunc := MakeProcInstance( proc, HInstance );
    If Not Assigned(EnumFunc ) then begin
       MessageDlg( 'MakeprocInstanceFail', mtError, [mbOK],0 );
       exit;
    end;
    hObj := TWindowObj.Create;
    hObj.SetTargetClass(TargetControlClass);
    Param := LongInt( hObj );
    result := 0;
    try
       ok := EnumChildWindows(h, EnumFunc, Param );
       targetWindow := hObj.GetWindowHandle;
    finally
      FreeProcInstance( EnumFunc );
      hObj.Free;
    end;
    result := h;
    if targetWindow <> 0 then begin
        if IsWindowEnabled( targetWindow ) then begin
            result := targetWindow;
        end;
    end;
end;

{================ TWindowObj =============================}
{transfer User Data from EnumChildWindow to EnumChildProc }
constructor TWindowObj.Create;
begin
     TargetClass := nil;
end;

destructor TWindowObj.Destroy;
begin
     if Assigned( TargetClass ) then begin
        StrDispose( TargetClass ) ;
     end;
     if Assigned( Buffer ) then begin
        StrDispose( Buffer ) ;
     end;
end;

function TWindowObj.Equal(handle: HWND ): boolean;
var
   classNameLength : integer;
begin
   result := false;
   classNameLength := GetClassname( handle, Buffer, NameLength + 1 );
   if classNameLength = 0 then exit;
   if StrLIComp( TargetClass, Buffer, NameLength ) = 0 then begin
      result := true;
   end;
end;

procedure  TWindowObj.SetTargetClass( ClassName: String );
begin
     if Assigned( TargetClass ) then begin
        StrDispose( TargetClass ) ;
     end;
     if Assigned( Buffer ) then begin
        StrDispose( Buffer ) ;
     end;
     NameLength := Length( ClassName );
     TargetClass := StrAlloc( NameLength + 1 );
     StrPCopy( TargetClass, ClassName );
     Buffer := StrAlloc( NameLength + 1 );
end;

procedure TWindowObj.SetWindowHandle( hWnd: HWND );
begin
     windowHandle := hWnd;
end;

function TWindowObj.GetWindowHandle: hWnd;
begin
     result := windowHandle;
end;

{=============  SendKeys ============================}
procedure SendOneKey( window: HWND; virtualKey: WORD; repeatCounter: Integer;
          shift: BOOLEAN; ctrl: BOOLEAN; menu: BOOLEAN; wait: BOOLEAN);
{ Send One VirtualKey, to other Window }
var
    lparam: LongInt;
    counter: integer;
    keyboardState: TKeyBoardState;
    test: BYTE;
begin
    window := GetFocusWindow( window );
    for counter := 0 to repeatCounter - 1 do begin
          lparam := $00000001;
          if menu then begin
             lparam := lparam or $20000000;
          end;
          if shift or ctrl or menu then begin
             { Set KeyboardState }
             GetKeyBoardState( keyboardState );
             if menu then begin
                PostMessage( window, WM_SYSKEYDOWN, ALTKEY, lparam );
                keyboardState[ALTKEY] := $81;
             end;
             if shift then begin
                PostMessage( window, WM_KEYDOWN, SHIFTKEY, lparam );
                keyboardState[SHIFTKEY] := $81;
             end;
             if ctrl then begin
                PostMessage( window, WM_KEYDOWN, CTRLKEY, lparam );
                keyboardState[CTRLKEY] := $81;
             end;
             SetKeyBoardState( keyboardState );
          end;
          if menu then begin
              PostMessage( window, WM_SYSKEYDOWN, virtualKey, lparam );
          end
          else begin
              PostMessage( window, WM_KEYDOWN, virtualKey, lparam );
          end;
          Application.ProcessMessages;
          lparam := lparam or $D0000000;
          if menu then begin
              PostMessage( window, WM_SYSKEYUP, virtualKey, lparam );
          end
          else begin
              PostMessage( window, WM_KEYUP, virtualKey, lparam );
          end;
          if shift or ctrl or menu then begin
             {unSet KeyBoardState }
             GetKeyBoardState( keyboardState );
             if ctrl then begin
                PostMessage( window, WM_KEYUP, CTRLKEY, lparam );
                keyboardState[CTRLKEY] := $00;
            end;
             if shift then begin
                PostMessage( window, WM_KEYUP, SHIFTKEY, lparam );
                keyboardState[SHIFTKEY] := $00;
             end;
             if menu then begin
                lparam := lparam and $DFFFFFFF;
                PostMessage( window, WM_SYSKEYUP, ALTKEY, lparam );
                keyboardState[ALTKEY] := $00;
             end;
             SetKeyBoardState( keyboardState );
          end;
    end;
end;

procedure SendOneChar( window: HWND; oneChar: Char; wait: BOOLEAN);
{ Send One Character to target Window }
var
    lparam: LongInt;
    counter: integer;
    key : WORD;
begin
    window := GetFocusWindow( window );
    lparam := $00000001;
    key := Word( oneChar );
    PostMessage( window, WM_CHAR, key, lparam );
    Application.ProcessMessages;
end;

function RecognizeChar( s : string ): BYTE;
{ Recognize Virtual Key by KEYWORD }
begin
     if (CompareText( s, 'BS') = 0) OR
        (CompareText(s, 'BACKSPACE') = 0) or
        ( CompareText(s,'BKSP') = 0 ) then begin
          result := $08;
     end
     else if CompareText(s, 'BREAK') = 0 then begin
          result := $13;
     end
     else if CompareText(s, 'CAPSLOCK') = 0 then begin
          result := $14;
     end
     else if CompareText(s,  'CLEAR') = 0 then begin
          result := $0C;
     end
     else if (CompareText(s, 'DEL') = 0 ) or
             (CompareText(s ,'DELETE') = 0) then begin
          result := $2E;
     end
     else if CompareText(s, 'DOWN') = 0 then begin
          result := $28;
     end
     else if CompareText(s, 'END') = 0 then begin
          result := $23;
     end
     else if CompareText(s,  'ENTER') = 0 then begin
          result := $0D;
     end
     else if (CompareText(s, 'ESC') = 0) OR
            ( CompareText(s, 'ESCAPE') = 0 ) then begin
          result := $1B;
     end
     else if CompareText(s, 'HELP') = 0 then begin
          result := $2F;
     end
     else if CompareText(s, 'HOME') = 0 then begin
          result := $24;
     end
     else if CompareText(s, 'INSERT') = 0 then begin
          result := $2D;
     end
     else if CompareText(s, 'LEFT') = 0 then begin
          result := $25;
     end
     else if CompareText(s, 'NUMLOCK') = 0 then begin
          result := $90;
     end
     else if CompareText(s, 'PGDN') = 0 then begin
          result := $22;
     end
     else if CompareText(s, 'PGUP') = 0 then begin
          result := $21;
     end
     else if CompareText(s, 'PRTSC') = 0 then begin
          result := $2C;
     end
     else if CompareText(s,  'RIGHT') = 0 then begin
          result := $27;
     end
     else if CompareText(s, 'SCROLLLOCK') = 0 then begin
          result := $91;
     end
     else if CompareText(s, 'TAB') = 0 then begin
          result := $09;
     end
     else if CompareText(s, 'UP') = 0 then begin
          result := $26;
     end
     else if CompareText(s, 'F1') = 0 then begin
          result := $70;
     end
     else if CompareText(s, 'F2') = 0 then begin
          result := $71;
     end
     else if CompareText(s, 'F3') = 0 then begin
          result := $72;
     end
     else if CompareText(s, 'F4') = 0 then begin
          result := $73;
     end
     else if CompareText(s, 'F5') = 0 then begin
          result := $74;
     end
     else if CompareText(s, 'F6') = 0 then begin
          result := $75;
     end
     else if CompareText(s, 'F7') = 0 then begin
          result := $76;
     end
     else if CompareText(s, 'F8') = 0 then begin
          result := $77;
     end
     else if CompareText(s, 'F9') = 0 then begin
          result := $78;
     end
     else if CompareText(s, 'F10') = 0 then begin
          result := $79;
     end
     else if CompareText(s,  'F11') = 0 then begin
          result := $7A;
     end
     else if CompareText(s, 'F12') = 0 then begin
          result := $7B;
     end
     else if CompareText(s, 'F13') = 0 then begin
          result := $7C;
     end
     else if CompareText(s, 'F14') = 0 then begin
          result := $7D;
     end
     else if CompareText(s, 'F15') = 0 then begin
          result := $7E;
     end
     else if CompareText(s, 'F16') = 0 then begin
          result := $7F;
     end
     else if CompareText(s, 'F17') = 0 then begin
          result := $80;
     end
     else if CompareText(s, 'F18') = 0 then begin
          result := $81;
     end
     else if CompareText(s, 'F19' ) = 0 then begin
          result := $82;
     end
     else if CompareText(s, 'F20') = 0 then begin
          result := $83;
     end
     else if CompareText(s,  'F21') = 0 then begin
          result := $84;
     end
     else if CompareText(s, 'F22') = 0 then begin
          result := $85;
     end
     else if CompareText(s, 'F23') = 0 then begin
          result := $86;
     end
     else if CompareText(s, 'F24') = 0 then begin
          result := $87;
     end
     else begin
         result := 0;
     end;
end;

function CharToVirtualKey( source: Char; var shift: boolean; var ctrl: boolean; var menu: boolean): WORD;
var
    resultCode: WORD;
    upperWord : WORD;
begin
    resultCode := VkKeyScan( Word(source) );
    upperWord := resultCode shr 8;
    case upperWord of
       1,3,4,5: shift := true;
       6 : begin
             ctrl := true;
             menu := true;
           end;
       7 : begin
             shift := true;
             ctrl := true;
             menu := true;
           end;
    end;
    result := resultCode and $00ff;
end;

function GetSpecialChar(specialChar: PChar; var repeatCount: Integer;
         var shift: boolean; var ctrl: boolean; var menu: boolean ): WORD;
{ In Brace String Parser}
var
    p : PChar;
    s : string;
    virtualKey : BYTE;
begin
    p := StrScan( specialChar, SPACE );
    if p <> nil then begin
       p^ := NULL;
       Inc(p);
       s := StrPas( p );
       repeatCount := StrtoInt( s );
    end
    else begin
       repeatCount := 1;
    end;
    s := StrPas( specialChar );
    virtualKey := RecognizeChar( s );
    if virtualKey = 0 then begin
       result := CharToVirtualKey(specialChar^, shift, ctrl, menu);
    end
    else begin
       result := virtualKey;
    end;
end;

procedure Parser( window: HWND; chars: PChar; wait:Boolean);
{Parse String Line and Send keys }
var
     p : PChar;
     specialChar: PChar;
     shift, ctrl, menu: Boolean;
     parenthese : Boolean;
     repeatCounter : Integer;
     oneChar : Char;
     vertualKey : Word;

     procedure ClearAddKey;
     begin
          shift := false;
          ctrl := false;
          menu := false;
     end;
begin
     p := chars;
     ClearAddKey;
     parenthese := false;
     while p^ <> NULL do begin
           if p^ = OPENBRACE then begin
               {Control Code }
               Inc( p );
               specialChar := p;
               while p^ <> NULL do begin
                   if p^ = CLOSEBRACE then begin
                      if (p + 1)^ = CLOSEBRACE then begin
                         Inc(p);
                      end;
                      break;
                   end;
                   Inc(p);
               end;
               if p^ = NULL then begin
                  MessageDlg('Illegal string ', mtError, [mbOK], 0 );
                   break;
               end;
               p^ := NULL;
               vertualKey := GetSpecialChar(specialChar, repeatCounter, shift, ctrl, menu);
               SendOneKey(window, vertualKey, repeatCounter, shift, ctrl, menu, wait);
               if not parenthese then begin
                     ClearAddKey;
               end;
           end
           else if p^ = PLUS then begin
                shift := true;
           end
           else if p^ = CARET then begin
                ctrl := true;
           end
           else if p^ = PERCENT then begin
                menu := true;
           end
           else if p^ = TILDE then begin
               SendOneKey( window, ENTERKEY, 1, shift, ctrl, menu, wait);
               if not parenthese then begin
                  ClearAddKey;
               end;
           end
           else if (shift or ctrl or menu ) and ( p^ =  OPENPARENTHESES ) then begin
                parenthese := true;
           end
           else if parenthese and ( p^ = CLOSEPARENTHESES ) then begin
                parenthese := false;
           end
           else begin
               if  ($80 and BYTE(p^)) > 0 then begin
                   { 2 Bytes Char}
                   SendOneChar(window, p^, wait);
                   Inc(p);
                   SendOneChar(window, p^, wait );
               end
               else begin
                   vertualKey := CharToVirtualKey( p^,shift,ctrl,menu);
                   SendOneKey(window, vertualKey, 1, shift, ctrl, menu, wait);
               end;
               if not parenthese then begin
                  ClearAddKey;
               end;
           end;
           Inc(p);
     end;
end;

procedure SendKeys( h: HWND; const keys: string; wait:Boolean );
{ SendKeys send strings to Window by specific HWND.
  Before sending keys,  activate the window.
  if h = 0 then send string to current activate Window
  sorry, this version not use wait.}
var
     window: HWND;
     focusControl: HWND;
     chars: PChar;
begin
     { handle check}
     if h = 0 then begin
        window := GetActiveWindow;
     end
     else begin
        window := h;
        SetActiveWindow( window );
     end;

     chars := StrAlloc( length( keys ) + 1 );
     StrPCopy( chars, keys );
     Parser( window, chars, wait );
     StrDispose( chars );
end;


end.

Google läßt grüßen

Ich auch gruß

[SirThornberry]

Zitat von Periander:

also folgendes funktioniert jetzt:

postmessage(form2.Efname.Handle, wm_char, ord('\'), 0); will ich das zeichen aber an ein anderes fenster schicken, mit:

Delphi-Quellcode:

w := FindWindow(NIL,('Name des Fensters'));

sendmessage(w,wm_char,ord('\'),0);

geht es nichtmehr (auch nicht mit postmessage)

Sendest du die Message an das Eingabecontrol oder an das Hauptfenster? Der Name des Fensters (Eingabecontrols) ändert sich ja sobald etwas eingegeben wurde.
Wenn man an Form2.handle etwas schickt wird ja auch nicht der Text ins Eingabecontrol geschrieben. Ich glaub du hast enfach das falsche handle.