Содержание материала

Code:

{********** Begin WHookInt.pas **************}

 

unit WHookInt;

 

interface

 

uses

  Windows, Messages, SysUtils;

 

function SetHook(WinHandle: HWND; MsgToSend: Integer): Boolean; stdcall; export;

function FreeHook: Boolean; stdcall; export;

function MsgFilterFunc(Code: Integer; wParam, lParam: Longint): Longint stdcall; export;

 

implementation

 

 

// Memory map file stuff

 

{

The CreateFileMapping function creates unnamed file-mapping object

for the specified file.

}

 

function CreateMMF(Name: string; Size: Integer): THandle;

begin

  Result := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, Size, PChar(Name));

  if Result <> 0 then

  begin

    if GetLastError = ERROR_ALREADY_EXISTS then

    begin

      CloseHandle(Result);

      Result := 0;

    end;

  end;

end;

 

{ The OpenFileMapping function opens a named file-mapping object. }

 

function OpenMMF(Name: string): THandle;

begin

  Result := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(Name));

  // The return value is an open handle to the specified file-mapping object.

end;

 

{

The MapViewOfFile function maps a view of a file into

the address space of the calling process.

}

 

function MapMMF(MMFHandle: THandle): Pointer;

begin

  Result := MapViewOfFile(MMFHandle, FILE_MAP_ALL_ACCESS, 0, 0, 0);

end;

 

{

The UnmapViewOfFile function unmaps a mapped view of a file

from the calling process's address space.

}

 

function UnMapMMF(P: Pointer): Boolean;

begin

  Result := UnmapViewOfFile(P);

end;

 

function CloseMMF(MMFHandle: THandle): Boolean;

begin

  Result := CloseHandle(MMFHandle);

end;

 

 

// Actual hook stuff

 

type

  TPMsg = ^TMsg;

 

const

  VK_D = $44;

  VK_E = $45;

  VK_F = $46;

  VK_M = $4D;

  VK_R = $52;

 

  MMFName = 'MsgFilterHookDemo';

 

type

  PMMFData = ^TMMFData;

  TMMFData = record

    NextHook: HHOOK;

    WinHandle: HWND;

    MsgToSend: Integer;

  end;

 

  // global variables, only valid in the process which installs the hook.

var

  MMFHandle: THandle;

  MMFData: PMMFData;

 

function UnMapAndCloseMMF: Boolean;

begin

  Result := False;

  if UnMapMMF(MMFData) then

  begin

    MMFData := nil;

    if CloseMMF(MMFHandle) then

    begin

      MMFHandle := 0;

      Result := True;

    end;

  end;

end;

 

{

The SetWindowsHookEx function installs an application-defined

hook procedure into a hook chain.

 

WH_GETMESSAGE Installs a hook procedure that monitors messages

posted to a message queue.

For more information, see the GetMsgProc hook procedure.

}

 

function SetHook(WinHandle: HWND; MsgToSend: Integer): Boolean; stdcall;

begin

  Result := False;

  if (MMFData = nil) and (MMFHandle = 0) then

  begin

    MMFHandle := CreateMMF(MMFName, SizeOf(TMMFData));

    if MMFHandle <> 0 then

    begin

      MMFData := MapMMF(MMFHandle);

      if MMFData <> nil then

      begin

        MMFData.WinHandle := WinHandle;

        MMFData.MsgToSend := MsgToSend;

        MMFData.NextHook := SetWindowsHookEx(WH_GETMESSAGE, MsgFilterFunc, HInstance, 0);

 

        if MMFData.NextHook = 0 then

          UnMapAndCloseMMF

        else

          Result := True;

      end

      else

      begin

        CloseMMF(MMFHandle);

        MMFHandle := 0;

      end;

    end;

  end;

end;

 

 

{

The UnhookWindowsHookEx function removes the hook procedure installed

in a hook chain by the SetWindowsHookEx function.

}

 

function FreeHook: Boolean; stdcall;

begin

  Result := False;

  if (MMFData <> nil) and (MMFHandle <> 0) then

    if UnHookWindowsHookEx(MMFData^.NextHook) then

      Result := UnMapAndCloseMMF;

end;

 

 

 

(*

    GetMsgProc(

    nCode: Integer;  {the hook code}

    wParam: WPARAM;  {message removal flag}

    lParam: LPARAM  {a pointer to a TMsg structure}

    ): LRESULT;  {this function should always return zero}

 

    { See help on ==> GetMsgProc}

*)

 

function MsgFilterFunc(Code: Integer; wParam, lParam: Longint): Longint;

var

  MMFHandle: THandle;

  MMFData: PMMFData;

  Kill: boolean;

begin

  Result := 0;

  MMFHandle := OpenMMF(MMFName);

  if MMFHandle <> 0 then

  begin

    MMFData := MapMMF(MMFHandle);

    if MMFData <> nil then

    begin

      if (Code < 0) or (wParam = PM_NOREMOVE) then

        {

         The CallNextHookEx function passes the hook information to the

         next hook procedure in the current hook chain.

       }

        Result := CallNextHookEx(MMFData.NextHook, Code, wParam, lParam)

      else

      begin

        Kill := False;

 

        { Examples }

        with TMsg(Pointer(lParam)^) do

        begin

          // Kill Numbers

         if (wParam >= 48) and (wParam <= 57) then Kill := True;

          // Kill Tabulator

         if (wParam = VK_TAB) then Kill := True;

        end;

 

        { Example to disable all the start-Key combinations }

        case TPMsg(lParam)^.message of

          WM_SYSCOMMAND: // The Win Start Key (or Ctrl+ESC)

           if TPMsg(lParam)^.wParam = SC_TASKLIST then Kill := True;

 

          WM_HOTKEY:

            case ((TPMsg(lParam)^.lParam and $00FF0000) shr 16) of

              VK_D,      // Win+D        ==> Desktop

             VK_E,      // Win+E        ==> Explorer

             VK_F,      // Win+F+(Ctrl) ==> Find:All (and Find: Computer)

             VK_M,      // Win+M        ==> Minimize all

             VK_R,      // Win+R        ==> Run program.

             VK_F1,     // Win+F1       ==> Windows Help

             VK_PAUSE:  // Win+Pause    ==> Windows system properties

               Kill := True;

            end;

        end;

        if Kill then TPMsg(lParam)^.message := WM_NULL;

        Result := CallNextHookEx(MMFData.NextHook, Code, wParam, lParam)

      end;

      UnMapMMF(MMFData);

    end;

    CloseMMF(MMFHandle);

  end;

end;

 

 

initialization

  begin

    MMFHandle := 0;

    MMFData   := nil;

  end;

 

finalization

  FreeHook;

end.

 

{********** End WHookInt.pas **************}

 

Добавить комментарий

Не использовать не нормативную лексику.

Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.

ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!


Защитный код
Обновить