FTP | CCD | Buscar | Trucos | Trabajo | Foros |
|
Registrarse | FAQ | Miembros | Calendario | Guía de estilo | Temas de Hoy |
|
Herramientas | Buscar en Tema | Desplegado |
#1
|
|||
|
|||
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. 1) Mediante FindWindow consigo un handle a dicha aplicación a partir de su nombre: Código:
H := FindWindow(nil, 'Ctlcomp'); Código:
BringWindowToTop(H); sendkeys('{ENTER}',H); 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. |
#3
|
||||
|
||||
Yo me inclino más a pensar que es algo relacionado con la seguridad en Vista , por aquello de "enviar comandos" desde una aplicación a otra podría ser cosa de virus ....
Esperemos me equivoque.
__________________
Si usted entendió mi comentario, contácteme y gustosamente, se lo volveré a explicar hasta que no lo entienda, Gracias. |
|
|
|