Форум: "WinAPI";
Текущий архив: 2004.12.12;
Скачать: [xml.tar.bz2];

Вниз

Пример low level хука   Найти похожие ветки 

← →
MetalFan ©   (2004-10-15 16:55) [8]

код DLL
unit KBDHookInt;

interface

uses
  Windows, Messages, SysUtils;

function SetHook(LockWin, LockCaps, LockACD: boolean): Boolean; stdcall;export;
function FreeHook: Boolean; stdcall; export;
function MsgFilterFunc(Code: Integer; wParam, lParam: Longint): Longint stdcall; export;

implementation

 function DoWriteLog(aLogString: String): boolean; overload;
 var
   lFile: TextFile;
   lFN: string;
 begin
   exit;
   lFN := "c:\KBDHOOKlog.txt";
   AssignFile(lFile, lFN);
   try
     if FileExists(lFN) then
       Append(lFile)
     else
       Rewrite(lFile);
     Writeln(lfile, Format("[%s] %s",[DateTimeToStr(now),aLogString]));
   finally
     CloseFile(lFile);
   end;
   result := true;
 end;

 function DoWriteLog(FormatStr: string; Params: array of const): boolean; overload;
 begin
   DoWriteLog(  Format( FormatStr, Params )  );
   result := true;
 end;

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

const
  MMFName = "KBDFilterHookF068DFB2CEC2";
  LLKHF_ALTDOWN = $20;

type
  PMMFData = ^TMMFData;
  TMMFData = record
    NextHook: HHOOK;
    LockWIN,
    LockCaps,
    LockACD,
    APrsd,
    CPrsd,
    DPrsd: boolean;
  end;

  // global variables, only valid in the process which installs the hook.
var
  MMFHandle: THandle;
  MMFData: PMMFData;
//   SetOfACDPressed: set of char;

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;

function SetHook(LockWin, LockCaps, lockACD: boolean): Boolean; stdcall;
begin
  Result := LockWin or LockCaps or LockACD;
  if not result then
    exit;
  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^.LockWIN := LockWin;
        MMFData^.LockCaps := LockCaps;
        MMFData^.LockACD := LockACD;
        MMFData^.APrsd := false;
        MMFData^.CPrsd := false;
        MMFData^.DPrsd := false;
        MMFData^.NextHook := SetWindowsHookEx(13 {WH_KEYBOARD_LL}, MsgFilterFunc, HInstance, 0);

        if MMFData^.NextHook = 0 then
          UnMapAndCloseMMF
        else
          Result := True;
      end
      else
      begin
        CloseMMF(MMFHandle);
        MMFHandle := 0;
      end;
    end;
  end;
end;

function FreeHook: Boolean; stdcall;
begin
  Result := False;
  if (MMFData <> nil) and (MMFHandle <> 0) then
    if UnHookWindowsHookEx(MMFData^.NextHook) then
      Result := UnMapAndCloseMMF;
//   SetOfACDPressed := [];
end;

type
  PKeybdHookStruct = ^TKeybdHookStruct;
  TKeybdHookStruct = record
     vkCode: DWORD;
     scanCode: DWORD;
     flags: DWORD;
     time: DWORD;
     dwExtraInfo: PULONG;
  end;
const
  CAltSet  : set of byte = [164,165];
  CCtrlSet : set of byte = [162,163];
  CDelSet  : set of byte = [46,110];

function MsgFilterFunc(Code: Integer; wParam, lParam: Longint): Longint;
var
  MMFHandle: THandle;
  MMFData: PMMFData;
  Kill: boolean;
  BlockSet: Set Of byte;
  lHkStruct: PKeybdHookStruct;
  lPressedCount: integer;
begin
  Result := 0;
  lPressedCount := 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
        Result := CallNextHookEx(MMFData^.NextHook, Code, wParam, lParam)
      else
      if Code = HC_ACTION then
      begin
        Kill := False;
        lHkStruct := Pointer(lParam);
        BlockSet := [];
        if MMFData^.LockWIN then
          BlockSet := BlockSet + [91,92];
        if MMFData^.LockCaps then
          BlockSet := BlockSet + [20];
        KILL := lHkStruct^.vkCode in BlockSet;
        DoWriteLog("wPar: $%s, %S;  KK: $%s, %s",
         [IntToHex(wParam, 2),IntToStr(wParam), IntToHex(lHkStruct^.vkCode, 8), IntToStr(lHkStruct^.vkCode)]);
        if kill then
          result := 1
        else
          Result := CallNextHookEx(MMFData^.NextHook, Code, wParam, lParam);
      end;
      UnMapMMF(MMFData);
    end;
    CloseMMF(MMFHandle);
  end;
end;

initialization
    MMFHandle := 0;
    MMFData   := nil;

 finalization
    FreeHook;
end.


---

Страницы: 1 вся ветка

Форум: "WinAPI";
Текущий архив: 2004.12.12;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.035 c