Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > OOP
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Grupo de Teaming del ClubDelphi

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 31-10-2008
sur-se sur-se is offline
Miembro
 
Registrado: may 2003
Posts: 212
Poder: 22
sur-se Va por buen camino
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.
Responder Con Cita
  #2  
Antiguo 31-10-2008
[coso] coso is offline
Miembro Premium
 
Registrado: may 2008
Ubicación: Girona
Posts: 1.678
Poder: 0
coso Va por buen camino
Hola, podrias probar otras funciones para enviar teclas. Aqui en el club se ha tratado varias veces el tema. Te dejo un link. Saludos.
Responder Con Cita
  #3  
Antiguo 31-10-2008
Avatar de Lepe
[Lepe] Lepe is offline
Miembro Premium
 
Registrado: may 2003
Posts: 7.424
Poder: 29
Lepe Va por buen camino
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.
Responder Con Cita
Respuesta



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro


La franja horaria es GMT +2. Ahora son las 03:53:27.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi