unit Unit3;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls,
  WindowsData, HookData;

type
  TfrmMessages = class(TForm)
    GroupBox1: TGroupBox;
    Label1: TLabel;
    lstAvailMessages: TListBox;
    lstSelMessages: TListBox;
    Label2: TLabel;
    cmbAddMessage: TButton;
    cmDelMessage: TButton;
    GroupBox2: TGroupBox;
    cmbStart: TButton;
    cmbClose: TButton;
    lvwMessages: TListView;
    cmbClear: TButton;
    procedure cmbCloseClick(Sender: TObject);
    procedure cmbAddMessageClick(Sender: TObject);
    procedure cmDelMessageClick(Sender: TObject);
    procedure cmbStartClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure WndProc(var Message: TMessage); override;
    procedure cmbClearClick(Sender: TObject);
  private
    { Private declarations }
    wnd: HWND;
    hook: HHOOK;
    procedure LoadFilter();
    function GetMessageIndex(listIndex: Integer; used: Boolean):Integer;
  public
    { Public declarations }
    procedure ShowMessages(wnd: HWND);
  end;

//****************************************************
//Импортируемые из библиотеки hook.dll функции (и данные, нужные для них)
  function InstallHook(wnd: HWND; spy: HWND): Boolean stdcall;
  external 'hook\hook.dll' name 'InstallHook';
  function RemoveHook(): Boolean stdcall;
  external 'hook\hook.dll' name 'RemoveHook';
//****************************************************

var
  frmMessages: TfrmMessages;

implementation
{$R *.dfm}

procedure TfrmMessages.cmbCloseClick(Sender: TObject);
begin
  Close();
end;

procedure TfrmMessages.ShowMessages(wnd: HWND);
begin
  self.wnd := wnd;
  LoadFilter();
  ShowModal();
end;

procedure TfrmMessages.LoadFilter();
var
  i: Integer;
begin
  //Загрузка фильтра сообщений
  lstAvailMessages.Clear();
  lstSelMessages.Clear();
  for i := mess_first to mess_last do
    if messages_list[i].used then
      //Сообщение соощение перехватывается
      lstSelMessages.Items.Add(messages_list[i].name)
    else
      lstAvailMessages.Items.Add(messages_list[i].name);
end;

procedure TfrmMessages.cmbAddMessageClick(Sender: TObject);
var
  i: Integer;
begin
  if lstAvailMessages.SelCount = 0 then Exit;
  //Включение выбранных сообщений в список перехватываемых
  for i := lstAvailMessages.Count - 1 downto 0 do
    if lstAvailMessages.Selected[i] then
      messages_list[GetMessageIndex(i, False)].used := True;
  //Отобразим изменения в списках
  LoadFilter();
end;

procedure TfrmMessages.cmDelMessageClick(Sender: TObject);
var
  i: Integer;
begin
  if lstSelMessages.SelCount = 0 then Exit;
  //Исключение выбранных сообщений из списка перехватываемых
  for i := lstSelMessages.Count - 1 downto 0 do
    if lstSelMessages.Selected[i] then
      messages_list[GetMessageIndex(i, True)].used := False;
  //Отобразим изменения в списках
  LoadFilter();
end;

//Функция преобразует номер сообщения в списке в номер сообщения в
//массиве messages_list
function TfrmMessages.GetMessageIndex(listIndex: Integer; used: Boolean)
                        :Integer;
var
  i, count: Integer;
begin
  count := 0;
  for i := mess_first to mess_last do
    if messages_list[i].used = used then
    begin
      if count = listIndex then
      begin
        //Нашли
        GetMessageIndex := i;
        Exit;
      end;
      Inc(count);
    end;
  GetMessageIndex := 0;
end;

procedure TfrmMessages.cmbStartClick(Sender: TObject);
begin
  if cmbStart.Caption <> 'Остановить' then
  begin
    //Начинаем слежение
    lvwMessages.Clear;
    //Создаем проекцию файла
    hFile := CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE,
                               0, SizeOf(THookInfo), strFileMapName);
    hook_info := MapViewOfFile(hFile, FILE_MAP_WRITE, 0, 0, SizeOf(THookInfo));
    //Создание ловушки
    if InstallHook(wnd, frmMessages.Handle) then
      cmbStart.Caption := 'Остановить'
    else
    begin
      //При ошибке удалим проекцию файла
      UnmapViewOfFile(hook_info);
      hook_info := nil;
      CloseHandle(hFile);
      hFile := 0;
      MessageBox(Handle, 'Ошибка при создании ловушки',
                 PAnsiChar(Application.Title), MB_ICONEXCLAMATION);
    end;
  end
  else
  begin
    //Заканчиваем слежение (удаляем ловушку и проекцию файла)
    RemoveHook();
    UnmapViewOfFile(hook_info);
    hook_info := nil;
    CloseHandle(hFile);
    hFile := 0;
    cmbStart.Caption := 'Начать слежение';
  end;
end;

procedure TfrmMessages.FormDestroy(Sender: TObject);
begin
  //На случай, если идет слежение за окном
  if hook <> 0 then
    cmbStartClick(nil);
end;

procedure TfrmMessages.WndProc(var Message: TMessage);
var
  item: TListItem;
  i: Integer;
begin
  if (Message.Msg = WM_SPY_NOTIFY) and (hook_info <> nil) then
  begin
    //Обрабатываем уведомление о приходе сообщения в наблюдаемое окно
    for i := mess_first to mess_last do
      if (messages_list[i].value = hook_info^.mess) and
          messages_list[i].used then
      begin
        item := lvwMessages.Items.Add();
        item.Caption := messages_list[i].name;
        item.SubItems.Add(IntToStr(hook_info^.wParam));
        item.SubItems.Add(IntToStr(hook_info^.lParam));
      end;
  end
  else
    inherited WndProc(Message);
end;

procedure TfrmMessages.cmbClearClick(Sender: TObject);
begin
  lvwMessages.Clear();
end;

end.
