freepascal.ru

Доброго времени суток!

Столкнулся с проблемой: как сворачивать/разворачивать приложение в трей.
Как назначить горячие клавиши для вызова окна приложения из трея?

Используйте горячие клавиши PopupMenu,

Уточню вопрос.
Платформа Win7 (UAC отключен).

Обязательно ли, как в распространенных примерах выносить конструкцию

Код: Выделить всё

theHook := SetWindowsHookEx(WH_KEYBOARD, @MyHook, hInstance, 0); //установка ловушки

в dll?

Проблема: в том, что после установки:

Код: Выделить всё

theHook := SetWindowsHookEx(WH_KEYBOARD, @MyHook, hInstance, 0); //установка ловушки

получаю theHook = 0, что не есть хорошо (хук не устанавливается).
Курение поисковиков привело к тому, что передаваемый в параметрах 0 указывает на глобальный (для всех запущенных приложений) хук.
Является ли данная проблема проблемой среды разработки (использую Lazarus 1.0.10)?

PapaNT писал(а):получаю theHook = 0, что не есть хорошо (хук не устанавливается).

А что GetLastError говорит?

PapaNT писал(а):Является ли данная проблема проблемой среды разработки (использую Lazarus 1.0.10)?

А при чем здесь среда разработки, вы ведь WinAPI функцию вызываете, а не лазаруса.

SeZuka, был глюк среды разработки (она свалилась при попытке сборки и запуска версии приложения с выводом GetLastError).
После перезапуска лазаря хук заработал нормально и без dll.

Осталось решить вопрос с сокрытием окна приложения (до этого писал большей частью консольные утилиты)...

Код: Выделить всё

theHook := SetWindowsHookEx(WH_KEYBOARD, @MyHook, hInstance, 0); //установка ловушки

Выдает ошибку GetLastError = 1428.
Если использовать

Код: Выделить всё

theHook := SetWindowsHookEx(WH_KEYBOARD, @MyHook, hInstance, GetCurrentThreadID); //установка ловушки

то хук работет, но только в рамках текущего приложения (а этого мало).

Уважаемые коллеги, не посоветуете ли как в Windows 7 обеспечить работоспособность кода:

Код: Выделить всё

theHook := SetWindowsHookEx(WH_KEYBOARD, @MyHook, hInstance, 0); //установка ловушки

???

PapaNT писал(а):Выдает ошибку GetLastError = 1428.

Это вроде как значит ERROR_HOOK_NEEDS_HMOD, судя по всему что нужно не инстанс приложения, а дллки.

PapaNT писал(а):Уважаемые коллеги, не посоветуете ли как в Windows 7 обеспечить работоспособность кода:
КОД: ВЫДЕЛИТЬ ВСЁ
theHook := SetWindowsHookEx(WH_KEYBOARD, @MyHook, hInstance, 0); //установка ловушки
???

Сделать DLL

На базе примера из соседнего топика http://www.freepascal.ru/forum/viewtopic.php?f=5&t=5820 создал свою библиотеку:

Код: Выделить всё

library hook;

{$mode objfpc}{$H+}

uses
  windows, messages, sysutils//, IniFiles
  { you can add units after this };
  //модуль Classes удален для экономии размера ДЛЛ

Const
  Status_Flag : boolean = False;
var
    theHook: THandle;  //хэндл ловушки для дальнейшего удаления
    VKCode : Word;

//-------------------------------------------------------------------------
Function Status : boolean;
begin
  if Status_Flag Then
     begin
       Status_Flag := False;
       Status := True
     end
                 Else
       Status := False
end;

//-------------------------------------------------------------------------
function MyHook(nCode, wParam, lParam: integer): Lresult; stdcall;
//var
//     X:Integer;
begin

   if nCode < 0 then
  begin            //фигня какая то, передаем дальше
    result := CallNextHookEx(theHook, nCode, wParam, lParam);
    exit;
  end;
           //(lParam >$8000) - считаем только нажатие клавиш (GetKeyState(VK_SHIFT)<>0)
    if (wParam = VKCode) and (lParam >$8000)     then // VKCode - переданный ранее код клавиатуры
     begin
       // Наши действия по сработке
       Status_Flag := True;
     end;

    result := CallNextHookEx(theHook, nCode, wParam, lParam); //дальше по цепочке
end;

//-------------------------------------------------------------------------
procedure Start(VK_Code : Word);
begin
  VKCode := VK_Code; // Установка кода клавиатуры (код кнопки)
  theHook := SetWindowsHookEx(WH_KEYBOARD, @MyHook, hInstance, 0); //установка ловушки
  if theHook = 0 then // Проверка корректности запуска хука
    messageBox(0, PChar(IntToStr(GetLastError)), 'Error!', mb_ok); // Выводим сообщение об ошибке
end;
//-------------------------------------------------------------------------
procedure Remove;
begin
  UnhookWindowsHookEx(theHook);   //удаление ловушки
end;
//-------------------------------------------------------------------------
//{$R *.res}

Exports

Start     index 1 name 'Start',
Remove    index 2 name 'Remove',
Status    index 3 name 'Status';

begin
end.


По коду осталось пара вопросов:
1. Перехват работает только локально в окне программы. Хотелось бы чтобы работало из всех окон.
2. ИМХО, малость удобнее, но хотелось бы уточнить по вопросу стиля программирования (прошу не бросаться гнилыми помидорами). В DLL-ке объявлена функция Status, возвращающая состояние срабатывания хука. Из вызывающей программы я опрашиваю статус по таймеру (10 раз в секунду). Хорош ли примененный стиль или же есть более красивые формы опроса (в моем учебнике по Delphi что-то было написано про события, но написано мало и не очень ясно).

PapaNT писал(а):В DLL-ке объявлена функция Status, возвращающая состояние срабатывания хука. Из вызывающей программы я опрашиваю статус по таймеру (10 раз в секунду). Хорош ли примененный стиль или же есть более красивые формы опроса

Передать в DLL адрес обрабатывающей функции из своей проги, каждый раз при срабатывании хука DLL-ка будет вызывать обработчик из вашей программы и передавать туда параметры.

SeZuka писал(а):Передать в DLL адрес обрабатывающей функции из своей проги, каждый раз при срабатывании хука DLL-ка будет вызывать обработчик из вашей программы и передавать туда параметры.

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


Выяснилось неприятное обстоятельство, что хук срабатывает лишь в окне программы. Тестирование проводил на Win`7 и W2k3.