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.