unit Sendkey;
{
      This is a procedure named "SendKeys".
      This function like the same named statment of Visual Basic.
      It provide the same features by VB's function.
      This version not use "wait" flg.
      Ver 1.2   '95.9.7

                     CopyRights 1995, Makoto Muramatsu
}

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.