| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Delphi и обработка нажатий клавиш в др. приложениях [D7]

SlaT ©   (2005-01-27 12:56:00) 

Помогите реализовать следущее - что бы при нажатии заранее заданой последовательности букв она заменялась на что-то. Причем в другом приложении.

Скажем открыл я Блокнот и пишу там 123, программа отловила и заменила на 321.

Заранее спасибо!

---

Вариант   (2005-01-27 13:56:00) [1]

Сначала, с помощью hook отлавливаешь все нажатые клавиши:
//Так как ловушка глобальная, то естественно нужно DLL

library HookLib;

uses
  madExcept,
  Windows,
  Messages,
  SysUtils;

type
  PHookRec = ^THookRec;
  THookRec = record
    AppHnd: Integer;
    MemoHnd: Integer;
  end;

var
  Hooked: Boolean;
  hKeyHook, hMemo, hMemFile, hApp: HWND;
  PHookRec1: PHookRec;

function KeyHookFunc(Code, VirtualKey, KeyStroke: Integer): LRESULT; stdcall;
var
  KeyState1: TKeyBoardState;
  AryChar: array[0..1] of Char;
  Count: Integer;
begin
  Result := 0;
  if Code = HC_NOREMOVE then Exit;
  Result := CallNextHookEx(hKeyHook, Code, VirtualKey, KeyStroke);
  {I moved the CallNextHookEx up here but if you want to block
  or change any keys then move it back down}
  if Code < 0 then
    Exit;

  if Code = HC_ACTION then
  begin
    if ((KeyStroke and (1 shl 30)) <> 0) then
      if not IsWindow(hMemo) then
      begin
       {I moved the OpenFileMapping up here so it would not be opened
       unless the app the DLL is attatched to gets some Key messages}
        hMemFile  := OpenFileMapping(FILE_MAP_WRITE, False, 'Global7v9k');
        PHookRec1 := MapViewOfFile(hMemFile, FILE_MAP_WRITE, 0, 0, 0);
        if PHookRec1 <> nil then
        begin
          hMemo := PHookRec1.MemoHnd;
          hApp  := PHookRec1.AppHnd;
        end;
      end;
    if ((KeyStroke and (1 shl 30)) <> 0) then
    begin
      GetKeyboardState(KeyState1);
      Count := ToAscii(VirtualKey, KeyStroke, KeyState1, AryChar, 0);
      if Count = 1 then
      begin
        SendMessage(hMemo, WM_CHAR, Ord(AryChar[0]), 0);
        {I included 2 ways to get the Charaters, a Memo Hnadle and
        a WM_USER+1678 message to the program}
        PostMessage(hApp, WM_USER + 1678, Ord(AryChar[0]), 0);
      end;
    end;
  end;
end;

function StartHook(MemoHandle, AppHandle: HWND): Byte; export;
begin
  Result := 0;
  if Hooked then
  begin
    Result := 1;
    Exit;
  end;
  if not IsWindow(MemoHandle) then
  begin
    Result := 4;
    Exit;
  end;
  hKeyHook := SetWindowsHookEx(WH_KEYBOARD, KeyHookFunc, hInstance, 0);
  if hKeyHook > 0 then
  begin
    {you need to use a mapped file because this DLL attatches to every app
    that gets windows messages when it's hooked, and you can't get info except
    through a Globally avaiable Mapped file}
    hMemFile := CreateFileMapping($FFFFFFFF, nil,  
     PAGE_READWRITE,    
     0,                
     SizeOf(THookRec),  
     //SizeOf(Integer),
     'Global7v9k');  
   PHookRec1 := MapViewOfFile(hMemFile, FILE_MAP_WRITE, 0, 0, 0);
    hMemo := MemoHandle;
    PHookRec1.MemoHnd := MemoHandle;
    hApp := AppHandle;
    PHookRec1.AppHnd := AppHandle;
    {set the Memo and App handles to the mapped file}
    Hooked := True;
  end
  else
    Result := 2;
end;

function StopHook: Boolean; export;
begin
  if PHookRec1 <> nil then
  begin
    UnmapViewOfFile(PHookRec1);
    CloseHandle(hMemFile);
    PHookRec1 := nil;
  end;
  if Hooked then
    Result := UnhookWindowsHookEx(hKeyHook)
  else
    Result := True;
  Hooked := False;
end;

procedure EntryProc(dwReason: DWORD);
begin
  if (dwReason = Dll_Process_Detach) then
  begin
    if PHookRec1 <> nil then
    begin
      UnmapViewOfFile(PHookRec1);
      CloseHandle(hMemFile);
    end;
    UnhookWindowsHookEx(hKeyHook);
  end;
end;

exports
  StartHook,
  StopHook;

begin
  PHookRec1 := nil;
  Hooked := False;
  hKeyHook := 0;
  hMemo := 0;
  DLLProc := @EntryProc;
  EntryProc(Dll_Process_Attach);
end.

++++++++++++++++++++++++++++++++++++++++++++++++++++++++

2. Следующий код использует заготовленную ранее DLL

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    but_StartHook: TButton;
    but_StopHook: TButton;
    label1: TLabel;
    Memo1: TMemo;
    procedure but_StartHookClick(Sender: TObject);
    procedure but_StopHookClick(Sender: TObject);
  private
    { Private declarations }
    hLib2: THandle;
    DllStr1: string;
    procedure DllMessage(var Msg: TMessage); message WM_USER + 1678;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.DllMessage(var Msg: TMessage);
begin
  if (Msg.wParam = 8) or (Msg.wParam = 13) then Exit;
  {the 8 is the Backspace and the 13 if the Enter key, You'll need to
 do some special handleing for a string}
  DllStr1 := DllStr1 + Chr(Msg.wParam);
  label1.Caption := DllStr1;
end;

procedure TForm1.but_StartHookClick(Sender: TObject);
type
  TStartHook = function(MemoHandle, AppHandle: HWND): Byte;
var
  StartHook1: TStartHook;
  SHresult: Byte;
begin
  hLib2 := LoadLibrary('HookLib.dll');
  @StartHook1 := GetProcAddress(hLib2, 'StartHook');
  if @StartHook1 = nil then Exit;
  SHresult := StartHook1(Memo1.Handle, Handle);
  if SHresult = 0 then ShowMessage('the Key Hook was Started, good');
  if SHresult = 1 then ShowMessage('the Key Hook was already Started');
  if SHresult = 2 then ShowMessage('the Key Hook can NOT be Started, bad');
  if SHresult = 4 then ShowMessage('MemoHandle is incorrect');
end;

procedure TForm1.but_StopHookClick(Sender: TObject);
type
  TStopHook = function: Boolean;
var
  StopHook1: TStopHook;
  hLib21: THandle;
begin
  @StopHook1 := GetProcAddress(hLib2, 'StopHook');
  if @StopHook1 = nil then
  begin
    ShowMessage('Ошибка');
    Exit;
  end;
  if StopHook1 then
    ShowMessage('Ловушка удалена');
  FreeLibrary(hLib2);
//В XP эту функцию нужно использовать два раза
  FreeLibrary(hLib2);
end;

end.

Ну а потом методом сравнения нажатых клавиш с нужным тебе сочитанием и отправляешь новые данные:
procedure TForm1.Button1Click(Sender: TObject);
var
  wnd: HWND;
  i: Integer;
  s: string;
begin
  wnd := FindWindow('notepad', nil);//Ищем нужное окно
  if wnd <> 0 then
  begin
    wnd := FindWindowEx(wnd, 0, 'Edit', nil);

//Текст, который посылаем в notePad
   s := 'Hello';
    for i := 1 to Length(s) do
      SendMessage(wnd, WM_CHAR, Word(s[i]), 0);
    //Эмуляция Enter
   PostMessage(wnd, WM_KEYDOWN, VK_RETURN, 0);
    //Эмуляция пробел
   PostMessage(wnd, WM_KEYDOWN, VK_SPACE, 0);
  end;
end;

//Для отправки в WordPad немного подругому:
 {...}
  wnd := FindWindow('WordPadClass', nil);

  if wnd <> 0 then
  begin
    wnd := FindWindowEx(wnd, 0, 'RICHEDIT', nil);
  {...}
Надеюсь разберёшься

---

SlaT   (2005-01-27 13:21:00) [2]

Дело в том что логически я тоже это понимаю. Но вот реализация для меня сложновата...

Я совсем не намерен писать punto switcher он у меня итак стоит и мне нравиться :) Мне нужна маленькая программа для работы с тэгами.

Т.е. я хотел, что бы при вводе <b она автоматически заменяла это на ставя курсор посередние. Я не системный программист, скорее веб-программист среднего уровня и HTML-верстальщик. Но потихоньку и с Дельфями разбираться начинаю...

Был бы признателен за помощь. Всем уже ответившим спасибо!

---

Polevi   (2005-01-27 13:14:00) [3]

вопрос в том когда заменять

---

Smithson   (2005-01-27 13:11:00) [4]

Ставишь глобальный хук на клавиатуру и протоколируешь ввод до значимого разделителя (то есть до символов, при вводе которых клиент не может ошибиться). Потом анализируешь, чего он там навводил и если оно нуждается в замене, генеришь столько событий vk_backspace, сколько символов он навводил, потом генеришь события ввода правильных символов. Причем свой протоколятор на этот момент останавливаешь.
Примерно так работает punto switcher.

---

TUser   (2005-01-27 13:03:00) [5]

См. про хуки. Потом отправляй в активное окно несколько бэкспейсов (#8) и правильное написание слова.

---

Наверх