Delphi的SendKeys函数
软源LOGO
讲述咱程序员自己的故事

位置:软源 »编程 »文章

Delphi的SendKeys函数

coolapp;2012-10-07 13:51:59;浏览:6014
(*
	VB中有SendKeys函数
	DELPHI中一般用WinAPI (keybd_event,SendInput,PostMessage,SendMessage 等)		

	Converts a string of characters and key names to keyboard events and
	passes them to Windows.
	将一组由或字符或键名组成的字符串转换成按键事件交给Windows系统去处理。
	
	Example syntax:用法:
	SendKeys( 'abcdefg^{ENTER}', True); // 键入abcdefg[CTRL+回车]
*)

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];
	AllocationSize:Integer;

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;
分享到:
(转载→)