sur-se |
31-10-2008 12:55:59 |
Problema con sendkey
Hola. Utilizo Delphi 5 y tengo una aplicación que funciona bien en Windows 98/2K/XP pero ahora con el Windows Vista me da problemas.
Os indico. La aplicación entre otras funciones, ejecuta un programa .exe externo, el cual tiene un botón de Aceptar y la única forma de que finalice es dándole con el ratón a ese botón. Incluí en mi aplicación unas units que permitían enviar una tecla ENTER a dicha aplicación externa una vez ejecutada.
Reproduzco a continuación la unit que implemente el envío de una tecla a una aplicación externa.
Código:
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;H:HWND): TSendKeyError;
procedure WaitForHook;
procedure StopPlayback;
var
Playing: Boolean;
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[i]));
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:
{ 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. }
begin
{ increment message counter }
inc(MsgCount);
{ check to see if all messages have been played }
if MsgCount >= MessageList.Count then StopPlayback
{ otherwise copy next message from list into buffer }
else MessageBuffer := TEventMsg(MessageList.Items[MsgCount]^);
Result := 0;
end;
HC_GETNEXT:
{ 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 is processed right away. }
begin
{ 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, 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('Failed to set hook');
Playing := True;
end;
procedure MakeMessage(vKey: byte; M: Cardinal; H:HWND);
{ 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 := H; // ignored
end;
MessageList.Add(E);
end;
procedure KeyDown(vKey: byte;H:HWND);
{ Generates KeyDownMessage }
begin
{ don't generate a "sys" key if the control key is pressed }
{ (This is a Windows quirk) }
if AltPressed and (not ControlPressed) and (vKey in vkKeySet) then
MakeMessage(vKey, wm_SysKeyDown, H)
else
MakeMessage(vKey, wm_KeyDown, H);
end;
procedure KeyUp(vKey: byte;H:HWND);
{ Generates KeyUp message }
begin
{ don't generate a "sys" key if the control key is pressed }
{ (This is a Windows quirk) }
if AltPressed and (not ControlPressed) and (vKey in vkKeySet) then
MakeMessage(vKey, wm_SysKeyUp, H)
else
MakeMessage(vKey, wm_KeyUp, H);
end;
procedure SimKeyPresses(VKeyCode: Word;H:HWND);
{ 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, H);
{ press Control key if flag has been set }
if ControlPressed then
KeyDown(vk_Control, H);
{ 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, H); { ...press shift }
KeyDown(Lo(VKeyCode), H); { press key down }
KeyUp(Lo(VKeyCode), H); { 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, H); { ...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, H);
ControlPressed := False;
end;
{ Release Alt key if flag has been set, reset flag }
if AltPressed then begin
KeyUp(vk_Menu, H);
AltPressed := False;
end;
end;
procedure ProcessKey(S: String; H:HWND);
{ 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:
{ It's the beginning of a special token! }
begin
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), H);
end;
AltKey: AltPressed := True; // set Alt flag
ControlKey: ControlPressed := True; // set Control flag
ShiftKey: ShiftPressed := True; // set Shift flag
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, H);
end;
end;
Inc(index);
until index > Length(S);
end;
procedure WaitForHook;
begin
repeat Application.ProcessMessages until not Playing;
end;
function SendKeys(S: String;H:HWND): 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, H); // 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
Result := sk_UnknownError; // Catch-all exception handler
end;
end;
end.
La función prinicipal que utilizo es sendkey. El proceso que sigo es el siguiente:
1) Mediante FindWindow consigo un handle a dicha aplicación a partir de su nombre:
Código:
H := FindWindow(nil, 'Ctlcomp');
2) A continuación la pongo en primer plano y le envio la tecla ENTER:
Código:
BringWindowToTop(H);
sendkeys('{ENTER}',H);
Bueno, esto es más o menos, porque lo tengo en un bucle que comprueba si ya la ha cogido o no, pero básicamente ese es el procedimiento.
El problema es que no sé porque ahora en Windows Vista no funciona y no entiendo donde está el problema. No da error, pero no consigo enviarle el intro al botón correspondiente. La aplicación se abre pero es como si los intros ya no se enviaran por lo que no se me cierra la aplicación ejecutada y no sé como arreglarlo.
Gracias por la ayuda
Un saludo.
|