Probleme mit PostMessage(WM_KEYDOWN)

[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ß