Показать сообщение отдельно
  #10  
Старый 10.11.2010, 09:38
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

модуль программы:
Код:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure SCTASKLIST(var msg: TMessage); message WM_USER+$1001;
  end;

var
  Form1: TForm1;

procedure SetHook(hWnd: HWND; uMsg: Cardinal); external 'Hook.dll';
procedure UnSetHook(); external 'Hook.dll';

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  SetHook(Handle, WM_USER+$1001);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  UnSetHook(); 
end;

procedure TForm1.SCTASKLIST(var msg: TMessage);
begin
  Memo1.Lines.Add('Попытка вызвать меню "Пуск" через '+IntToStr(msg.LParam));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  SendMessage(Handle, WM_SYSCOMMAND, SC_TASKLIST, 0);
end;

end.

библиотека:

Код:
library Hook;

uses
  Windows, Messages;

type
  PGlobalData = ^TGlobalData;
  TGlobalData = record
    hWnd: HWND;
    uMsg: Cardinal;
  end;

  PKBDLLHOOKSTRUCT = ^KBDLLHOOKSTRUCT;
  KBDLLHOOKSTRUCT = record
    vkCode: DWORD;
    scanCode: DWORD;
    flags: DWORD;
    time: DWORD;
    dwExtraInfo: Pointer;
  end;

const
  FileMappingName: PChar = 'Shared_Memory_Start_Button';

  WH_KEYBOARD_LL = 13;
  WH_MOUSE_LL = 14;

var
  FileMappingHandle: THandle;
  GlobalData: PGlobalData = nil;

  hLowLevelKeyboardProc: HHOOK = 0;
  
  kEsc: Boolean;
  kCtrl: Boolean;

function LowLevelKeyboardProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  if nCode=HC_ACTION then
  begin
    case wParam of
      WM_KEYDOWN: begin
        if PKBDLLHOOKSTRUCT(lParam)^.vkCode=VK_ESCAPE then kEsc:=True
        else if (PKBDLLHOOKSTRUCT(lParam)^.vkCode=VK_LCONTROL) or (PKBDLLHOOKSTRUCT(lParam)^.vkCode=VK_RCONTROL) then kCtrl:=True;
      end;
      WM_KEYUP: begin
        if PKBDLLHOOKSTRUCT(lParam)^.vkCode=VK_ESCAPE then kEsc:=False
        else if (PKBDLLHOOKSTRUCT(lParam)^.vkCode=VK_LCONTROL) or (PKBDLLHOOKSTRUCT(lParam)^.vkCode=VK_RCONTROL) then kCtrl:=False;
      end;
    end;
    if (kEsc) and (kCtrl) then
    begin
      PostMessage(GlobalData^.hWnd, GlobalData^.uMsg, 0, VK_ESCAPE);
      Result:=1;
      Exit;
    end;
    if (PKBDLLHOOKSTRUCT(lParam)^.vkCode=VK_RWIN) then
    begin
      PostMessage(GlobalData^.hWnd, GlobalData^.uMsg, 0, VK_RWIN);
      Result:=1;
      Exit;
    end;
    if (PKBDLLHOOKSTRUCT(lParam)^.vkCode=VK_LWIN) then
    begin
      PostMessage(GlobalData^.hWnd, GlobalData^.uMsg, 0, VK_LWIN);
      Result:=1;
      Exit;
    end;
  end;
  Result:=CallNextHookEx(0, nCode, wParam, lParam);
end;

procedure SetHook(hWnd: HWND; uMsg: Cardinal);
begin
  kEsc:=False;
  kCtrl:=False;
  GlobalData^.hWnd:=hWnd;
  GlobalData^.uMsg:=uMsg;
  hLowLevelKeyboardProc:=SetWindowsHookEx(WH_KEYBOARD_LL, @LowLevelKeyboardProc, HInstance, 0);
end;

procedure UnSetHook();
begin
  if hLowLevelKeyboardProc<>0 then UnhookWindowsHookEx(hLowLevelKeyboardProc);
end;

exports
  SetHook, UnSetHook;

procedure DLLHandler(Reason: Integer);
begin
  case Reason of
    DLL_PROCESS_ATTACH: begin
      FileMappingHandle:=CreateFileMapping($ffffffff, nil, PAGE_READWRITE, 0, SizeOf(TGlobalData), FileMappingName);
      GlobalData:=MapViewOfFile(FileMappingHandle, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(TGlobalData));
    end;
    DLL_PROCESS_DETACH: begin
      UnmapViewOfFile(GlobalData);
      CloseHandle(FileMappingHandle);
    end;
  end;
end;

begin
  DllProc:=@DLLHandler;
  DLLHandler(DLL_PROCESS_ATTACH);
end.

http://data.cod.ru/74470
__________________
Пишу программы за еду.
__________________
Ответить с цитированием