SendKeys在Delphi中如何实现?(100分)

  • 主题发起人 主题发起人 ★幻影★
  • 开始时间 开始时间

★幻影★

Unregistered / Unconfirmed
GUEST, unregistred user!
VB中的SendKeys在控制其它程序时,实在是好用,我想问一下如何在Delphi如何作呢?
我已经试过了WM_syscommand、Wm_keydown、Wm_char这个消息都不行,请高手指点一下,
在Delphi中应该做才能实现这个功能呢?
 
在Delphi 5 开发人员指南中有一章是专门实现这个功能的,找本电子书看看吧,好长
 
没错,直接在 Delphi 中是不能这样做的,但在 Delphi 安装光盘里有一个这样的单元,
如果您没有,就看下面:
unit SendKey;
interface
uses
SysUtils, Windows, Messages, Classes, KeyDefs;
type
{ Error codes }
TSendKeyError = (sk_None, sk_FailSetHook, sk_InvalidToken, sk_UnknownError,
sk_AlreadyPlaying);
{ first vk code to last vk code }
TvkKeySet = set of vk_LButton..vk_Scroll;
{ exceptions }
ESendKeyError = class(Exception);
ESKSetHookError = class(ESendKeyError);
ESKInvalidToken = class(ESendKeyError);
ESKAlreadyPlaying = class(ESendKeyError);
function SendKeys(S: String): TSendKeyError;
procedure WaitForHook;
procedure StopPlayback;
var
Playing: Boolean = False;
implementation
uses Forms;
type
{ a TList descendant that know how to dispose of its contents }
TMessageList = class(TList)
public
destructor Destroy; override;
end;
const
{ valid "sys" keys }
vkKeySet: TvkKeySet = [Ord('A')..Ord('Z'), vk_Menu, vk_F1..vk_F12];
destructor TMessageList.Destroy;
var
i: longint;
begin
{ deallocate all the message records before discarding the list }
for i := 0 to Count - 1 do
Dispose(PEventMsg(Items));
inherited Destroy;
end;
var
{ variables global to the DLL }
MsgCount: word = 0;
MessageBuffer: TEventMsg;
HookHandle: hHook = 0;
MessageList: TMessageList = Nil;
AltPressed, ControlPressed, ShiftPressed: Boolean;
procedure StopPlayback;
{ Unhook the hook, and clean up }
begin
{ if Hook is currently active, then unplug it }
if Playing then
UnhookWindowsHookEx(HookHandle);
MessageList.Free;
Playing := False;
end;
function Play(Code: integer; wParam, lParam: Longint): Longint; stdcall;
{ This is the JournalPlayback callback function. It is called by Windows }
{ when Windows polls for hardware events. The code parameter indicates what }
{ to do. }
begin
case Code of
hc_Skip: begin
{ hc_Skip means to pull the next message out of our list. If we }
{ are at the end of the list, it's okay to unhook the JournalPlayback }
{ hook from here. }
{ increment message counter }
inc(MsgCount);
{ check to see if all messages have been played }
if MsgCount >= MessageList.Count then
StopPlayback
else
{ copy next message from list into buffer }
MessageBuffer := TEventMsg(MessageList.Items[MsgCount]^);
Result := 0;
end;
hc_GetNext: begin
{ hc_GetNext means to fill the wParam and lParam with the proper }
{ values so that the message can be played back. DO NOT unhook }
{ hook from within here. Return value indicates how much time until }
{ Windows should playback message. We'll return 0 so that it's }
{ processed right away. }
{ move message in buffer to message queue }
PEventMsg(lParam)^ := MessageBuffer;
Result := 0 { process immediately }
end
else
{ if Code isn't hc_Skip or hc_GetNext, then call next hook in chain }
Result := CallNextHookEx(HookHandle, Code, wParam, lParam);
end;
end;
procedure StartPlayback;
{ Initializes globals and sets the hook }
begin
{ grab first message from list and place in buffer in case we }
{ get a hc_GetNext before and hc_Skip }
MessageBuffer := TEventMsg(MessageList.Items[0]^);
{ initialize message count and play indicator }
MsgCount := 0;
{ initialize Alt, Control, and Shift key flags }
AltPressed := False;
ControlPressed := False;
ShiftPressed := False;
{ set the hook! }
HookHandle := SetWindowsHookEx(wh_JournalPlayback, Play, hInstance, 0);
if HookHandle = 0 then
raise ESKSetHookError.Create('Couldn''t set hook')
else
Playing := True;
end;
procedure MakeMessage(vKey: byte; M: Cardinal);
{ procedure builds a TEventMsg record that emulates a keystroke and }
{ adds it to message list }
var
E: PEventMsg;
begin
New(E); // allocate a message record
with E^ do begin
message := M; // set message field
paramL := vKey; // vk code in ParamL
paramH := MapVirtualKey(vKey, 0); // scan code in ParamH
time := GetTickCount; // set time
hwnd := 0; // ignored
end;
MessageList.Add(E);
end;
procedure KeyDown(vKey: byte);
{ Generates KeyDownMessage }
begin
{ don't generate a "sys" key if the control key is pressed (Windows quirk) }
if AltPressed and (not ControlPressed) and (vKey in vkKeySet) then
MakeMessage(vKey, wm_SysKeyDown)
else
MakeMessage(vKey, wm_KeyDown);
end;
procedure KeyUp(vKey: byte);
{ Generates KeyUp message }
begin
{ don't generate a "sys" key if the control key is pressed (Windows quirk) }
if AltPressed and (not ControlPressed) and (vKey in vkKeySet) then
MakeMessage(vKey, wm_SysKeyUp)
else
MakeMessage(vKey, wm_KeyUp);
end;
procedure SimKeyPresses(VKeyCode: Word);
{ This function simulates keypresses for the given key, taking into }
{ account the current state of Alt, Control, and Shift keys }
begin
{ press Alt key if flag has been set }
if AltPressed then
KeyDown(vk_Menu);
{ press Control key if flag has been set }
if ControlPressed then
KeyDown(vk_Control);
{ if shift is pressed, or shifted key and control is not pressed... }
if (((Hi(VKeyCode) and 1) <> 0) and (not ControlPressed)) or ShiftPressed then
KeyDown(vk_Shift); { ...press shift }
KeyDown(Lo(VKeyCode)); { press key down }
KeyUp(Lo(VKeyCode)); { release key }
{ if shift is pressed, or shifted key and control is not pressed... }
if (((Hi(VKeyCode) and 1) <> 0) and (not ControlPressed)) or ShiftPressed then
KeyUp(vk_Shift); { ...release shift }
{ if shift flag is set, reset flag }
if ShiftPressed then begin
ShiftPressed := False;
end;
{ Release Control key if flag has been set, reset flag }
if ControlPressed then begin
KeyUp(vk_Control);
ControlPressed := False;
end;
{ Release Alt key if flag has been set, reset flag }
if AltPressed then begin
KeyUp(vk_Menu);
AltPressed := False;
end;
end;
procedure ProcessKey(S: String);
{ This function parses each character in the string to create the message list }
var
KeyCode: word;
Key: byte;
index: integer;
Token: TKeyString;
begin
index := 1;
repeat
case S[index] of
KeyGroupOpen : begin
{ It's the beginning of a special token! }
Token := '';
inc(index);
while S[index] <> KeyGroupClose do begin
{ add to Token until the end token symbol is encountered }
Token := Token + S[index];
inc(index);
{ check to make sure the token's not too long }
if (Length(Token) = 7) and (S[index] <> KeyGroupClose) then
raise ESKInvalidToken.Create('No closing brace');
end;
{ look for token in array, Key parameter will }
{ contain vk code if successful }
if not FindKeyInArray(Token, Key) then
raise ESKInvalidToken.Create('Invalid token');
{ simulate keypress sequence }
SimKeyPresses(MakeWord(Key, 0));
end;
AltKey : begin
{ set Alt flag }
AltPressed := True;
end;
ControlKey : begin
{ set Control flag }
ControlPressed := True;
end;
ShiftKey : begin
{ set Shift flag }
ShiftPressed := True;
end;
else begin
{ A normal character was pressed }
{ convert character into a word where the high byte contains }
{ the shift state and the low byte contains the vk code }
KeyCode := vkKeyScan(S[index]);
{ simulate keypress sequence }
SimKeyPresses(KeyCode);
end;
end;
inc(index);
until index > Length(S);
end;
procedure WaitForHook;
begin
repeat Application.ProcessMessages until not Playing;
end;
function SendKeys(S: String): TSendKeyError;
{ This is the one entry point. Based on the string passed in the S }
{ parameter, this function creates a list of keyup/keydown messages, }
{ sets a JournalPlayback hook, and replays the keystroke messages. }
begin
Result := sk_None; // assume success
try
if Playing then raise ESKAlreadyPlaying.Create('');
MessageList := TMessageList.Create; // create list of messages
ProcessKey(S); // create messages from string
StartPlayback; // set hook and play back messages
except
{ if an exception occurs, return an error code, and clean up }
on E:ESendKeyError do begin
MessageList.Free;
if E is ESKSetHookError then
Result := sk_FailSetHook
else if E is ESKInvalidToken then
Result := sk_InvalidToken
else if E is ESKAlreadyPlaying then
Result := sk_AlreadyPlaying;
end
else
{ Catch-all exception handler }
Result := sk_UnknownError;
end;
end;
end.
==========================================
unit Keydefs;
interface
uses Windows;
const
MaxKeys = 24;
ControlKey = '^';
AltKey = '@';
ShiftKey = '~';
KeyGroupOpen = '{';
KeyGroupClose = '}';
type
TKeyString = String[7];
TKeyDef = record
Key: TKeyString;
vkCode: Byte;
end;
const
KeyDefArray : array[1..MaxKeys] of TKeyDef = (
(Key: 'F1'; vkCode: vk_F1),
(Key: 'F2'; vkCode: vk_F2),
(Key: 'F3'; vkCode: vk_F3),
(Key: 'F4'; vkCode: vk_F4),
(Key: 'F5'; vkCode: vk_F5),
(Key: 'F6'; vkCode: vk_F6),
(Key: 'F7'; vkCode: vk_F7),
(Key: 'F8'; vkCode: vk_F8),
(Key: 'F9'; vkCode: vk_F9),
(Key: 'F10'; vkCode: vk_F10),
(Key: 'F11'; vkCode: vk_F11),
(Key: 'F12'; vkCode: vk_F12),
(Key: 'INSERT'; vkCode: vk_Insert),
(Key: 'DELETE'; vkCode: vk_Delete),
(Key: 'HOME'; vkCode: vk_Home),
(Key: 'END'; vkCode: vk_End),
(Key: 'PGUP'; vkCode: vk_Prior),
(Key: 'PGDN'; vkCode: vk_Next),
(Key: 'TAB'; vkCode: vk_Tab),
(Key: 'ENTER'; vkCode: vk_Return),
(Key: 'BKSP'; vkCode: vk_Back),
(Key: 'PRTSC'; vkCode: vk_SnapShot),
(Key: 'SHIFT'; vkCode: vk_Shift),
(Key: 'ESCAPE'; vkCode: vk_Escape));
function FindKeyInArray(Key: TKeyString; var Code: Byte): Boolean;
implementation
uses SysUtils;
function FindKeyInArray(Key: TKeyString; var Code: Byte): Boolean;
{ function searches array for token passed in Key, and returns the }
{ virtual key code in Code. }
var
i: word;
begin
Result := False;
for i := Low(KeyDefArray) to High(KeyDefArray) do
if UpperCase(Key) = KeyDefArray.Key then begin
Code := KeyDefArray.vkCode;
Result := True;
Break;
end;
end;
end.
=============================================
unit Keys;
interface
type
TSendKeyError = (sk_None, sk_FailSetHook, sk_UnknownError, sk_InvalidToken);
function SendKeys(S: String): integer;
implementation
function SendKeys; external 'SendKey' index 2;
end.
======================================
unit SKeys;
interface
type
{ Return values for SendKeys function }
TSendKeyError = (sk_None, sk_FailSetHook, sk_InvalidToken, sk_UnknownError);
function SendKeys(P: PChar): TSendKeyError; stdcall;
implementation
function SendKeys; external 'SendKey' name 'SendKeys';
end.
=================================
library SKey;
uses
SysUtils,
Windows,
SendKey;
function SendKeys(P: PChar): TSendKeyError; stdcall;
begin
Result := SendKey.SendKeys(P);
end;
function IsPlaying: BOOL; stdcall;
begin
Result := Playing;
end;
procedure WaitForHook; stdcall;
begin
SendKey.WaitForHook;
end;
exports
SendKeys name 'SendKeys' resident,
IsPlaying name 'IsPlaying' resident,
WaitForHook name 'WaitForHook' resident;
begin
end.
===================================
应用例子:
program Testsend;
uses
Forms,
Main in 'MAIN.PAS' {Form1},
Skeys in 'SKEYS.PAS';
{$R *.RES}
begin
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
====================
unit Main;
interface
uses
SysUtils, Windows, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, Menus;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Button2: TButton;
MainMenu1: TMainMenu;
File1: TMenuItem;
Open1: TMenuItem;
Exit1: TMenuItem;
Button4: TButton;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Open1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses SendKey, KeyDefs;
procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.SetFocus; // focus Edit1
SendKeys('^{DELETE}I love...'); // send keys to Edit1
WaitForHook; // let keys playback
Perform(wm_NextDlgCtl, 0, 0); // move to Edit2
SendKeys('~delphi 4 ~developer''s ~guide!'); // send keys to Edit2
end;
procedure TForm1.Button2Click(Sender: TObject);
var
H: hWnd;
PI: TProcessInformation;
SI: TStartupInfo;
begin
FillChar(SI, SizeOf(SI), 0);
SI.cb := SizeOf(SI);
{ Invoke notepad }
if CreateProcess(nil, 'notepad', nil, nil, False, 0, nil, nil, SI, PI) then
begin
{ wait until notepad is ready to receive keystrokes }
WaitForInputIdle(PI.hProcess, INFINITE);
H := FindWindow('Notepad', nil); // find notepad window
if SetForegroundWindow(H) then // bring it to front
SendKeys('Hello from the SendKeys example!{ENTER}'); // send keys!
end
else
MessageDlg(Format('Failed to invoke Notepad. Error code %d',
[GetLastError]), mtError, [mbOk], 0);
end;
procedure TForm1.Open1Click(Sender: TObject);
begin
ShowMessage('Open');
end;
procedure TForm1.Exit1Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
WaitForInputIdle(GetCurrentProcess, INFINITE);
SendKeys('@fx');
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
WaitForHook;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
WaitForInputIdle(GetCurrentProcess, INFINITE);
SendKeys('@fo');
end;
end.
==================================================
不知怎么的,测试人家写好的代码,一步步敲总觉得不胜其烦,非敲断手指不可。
这样给你贴上来是不是轻松许多。
另外,你的题目取得比较明确,我这里贴了,也便于需要的朋友检索查找。
 
接受答案了.
 
后退
顶部