Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1528
  • Last Modified:

WH_CBT Strange Behavior

Hello,

I'm trying to use WH_CBT hooking to get a list of any activated process, however while testing i only get several HCBT_CLICKSKIPPED message codes at first and that's its, i don't receive any other messages which i am interested in like HCBT_CREATEWND or HCBT_ACTIVATE

Here is my full implementation:
//*****************************************************************************************
library HookLib;

uses
  SysUtils, Classes, Windows;

  type
  TClientCallBack = procedure(Code,wParam : integer) of object;


  var fHookhandle: THandle;
      clientFunction : TClientCallBack;

{$R *.res}

function callbackFunction(Code, wParam, lParam: Integer): Integer; stdcall;
begin
  OutputDebugString(PChar('code from dll' + InttoStr(Code))); // always prints 6 (HCBT_CLICKSKIPPED)
      if (Code < 0) then begin
     result := CallNextHookEx(fHookhandle, Code, wParam, lParam);
     exit;
  end;

  clientFunction(Code,wParam); //Calls client callback function

      result := CallNextHookEx(fHookhandle, Code, wParam, lParam);

end;


function InstallCBTHook(ClientCallBackFunction: TClientCallBack):boolean; stdcall;
begin

  clientfunction := ClientCallBackFunction;
      fHookhandle := SetWindowsHookEx(WH_CBT, @callbackFunction, hInstance, 0);
      if fHookhandle > 0 then result := true else result := false;

end;

procedure UninstallCBTHook();stdcall;
begin
      UnhookWindowsHookEx(fHookhandle);

end;


exports
   InstallCBTHook, UninstallCBTHook;

begin
end.
//*************************************************************************
0
yehiaeg
Asked:
yehiaeg
1 Solution
 
yehiaegAuthor Commented:
ahh this behavior was on Windows XP, i just tested the executable on Windows Vista and it caused explorer.exe to crash instantaneously, so obviously something is going wrong
0
 
ZhaawZSoftware DeveloperCommented:
>> clientfunction := ClientCallBackFunction;
You're setting this value only in 1 process (in that one which sets the hook). This .dll is then loaded into other processes, which have  their own memory space - value of clientfunction is not ClientCallBackFunction in their memory.
You may test it by setting default value of variable when defining it (var test : integer = 0;), changing it's value in InstallCBTHook and then doing something like "if test = 0 then MessageBeep(0);" in callback function. You'll probably hear beeps, which mean that "test" variable has default value, although it's changed in InstallCBTHook.

I'm not sure what's the best way to solve this though. Could be solved by using memory mapped files (I haven't done that yet) or sending messages with SendMessage() to comunicate with main application.
0
 
ariohCommented:
function callbackFunction( Code : Integer; WParam : wParam; LParam : lParam ): LResult; stdcall;
begin
  if Code >= 0 then
    begin
      OutputDebugString( PChar( 'code from dll ' + IntToStr( Code ) ) );
      clientFunction( Code, WParam );
    end;
  result := CallNextHookEx( fHookhandle, Code, wParam, lParam );
end;
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
ariohCommented:
sorry, wrong code

this is real working example

============ HookDemoConst.pas =======
unit HookDemoConst;

interface

uses
  Messages;

const
  MSG_CALLWNDPROC     = WM_USER + 1;
  MSG_CALLWNDPROCRET  = WM_USER + 2;
  MSG_CBT             = WM_USER + 3;
  MSG_GETMESSAGE      = WM_USER + 4;

implementation

end.

=============== CBT.dpr =============
library CBT;
uses
  SysUtils,
  Windows,
  HookDemoConst,
  Messages;

procedure SetHook; export; forward;
procedure UnSetHook; export; forward;
procedure SetMainHandle(Handle: HWND); export; forward;

exports
  SetHook index 1,
  UnSetHook index 2,
  SetMainHandle index 3;

type
  PHookRec = ^THookRec;
  THookRec = record
    MainWindow: HWND;
    HookID: HHOOK;
  end;

const
  rHookRec: PHookRec = nil;

procedure SetMainHandle(Handle: HWND);
begin
  rHookRec^.MainWindow := Handle;
end;

// hook proc
function CBT_HookProc(nCode: Integer; WPARAM: wParam; LPARAM: lParam): LResult; stdcall;
begin
  if nCode >= 0 then begin
    if rHookRec^.MainWindow <> 0 then
      SendMessage(rHookRec^.MainWindow, MSG_CBT, nCode, WPARAM);
  end;
  result := CallNextHookEx(rHookRec^.HookID, nCode, wParam, lParam);
end;

procedure SetHook;
begin
  rHookRec^.HookID := SetWindowsHookEx(WH_CBT, @CBT_HookProc, hInstance, 0);
end;

procedure UnSetHook;
begin
  UnHookWindowsHookEx(rHookRec^.HookID);
end;

procedure EntryPointProc(Reason: Integer);
const
  hMapObject: THandle = 0;
begin
  case reason of
    DLL_PROCESS_ATTACH:
      begin
        hMapObject := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(THookRec), '_CBT');
        rHookRec := MapViewOfFile(hMapObject, FILE_MAP_WRITE, 0, 0, 0);
      end;

    DLL_PROCESS_DETACH:
      begin
        try
          UnMapViewOfFile(rHookRec);
          CloseHandle(hMapObject);
        except
        end;
      end;

    DLL_THREAD_ATTACH:
      begin
      end;

    DLL_THREAD_DETACH:
      begin
      end;
  end;
end;

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


======================================
in the client app:

=====form public declaration:
    procedure WMCBT(var Message: TMessage); message MSG_CBT;


=====code:

procedure CBTSetHook;       external 'CBT.dll' name 'SetHook';
procedure CBTUnSetHook;     external 'CBT.dll' name 'UnSetHook';
procedure CBTSetMainHandle; external 'CBT.dll' name 'SetMainHandle';

procedure TfrmHookDemo.WMCBT(var Message: TMessage);

  procedure AddLine(Line: string);
  begin
    inc(CBTCnt);
    Memo1.Lines.Add(IntToStr(CBTCnt) + ': ' + Line);
  end;

begin
  case Message.WParam of
    HCBT_ACTIVATE:  AddLine('HCBT_ACTIVATE');
//    HCBT_CLICKSKIPPED:  AddLine('HCBT_CLICKSKIPPED');
    HCBT_CREATEWND: AddLine('HCBT_CREATEWND');
    HCBT_DESTROYWND:  AddLine('HCBT_DESTROYWND');
    HCBT_KEYSKIPPED:  AddLine('HCBT_KEYSKIPPED');
    HCBT_MINMAX:  AddLine('HCBT_MINMAX');
    HCBT_MOVESIZE:  AddLine('HCBT_MOVESIZE');
    HCBT_QS:  AddLine('HCBT_QS');
    HCBT_SETFOCUS:  AddLine('HCBT_SETFOCUS');
    HCBT_SYSCOMMAND:  AddLine('HCBT_SYSCOMMAND');
  end;
end;

procedure TfrmHookDemo.btnCBTSetClick(Sender: TObject);
begin
  CBTCnt := 0;
  CBTSetMainHandle(Handle);
  CBTSetHook;
end;

procedure TfrmHookDemo.btnCBTUnsetClick(Sender: TObject);
begin
  CBTUnsetHook;
end;
0
 
yehiaegAuthor Commented:
ok i followed what you were saying. ZhaawZ about using the memory mapped file, and arioh about the new function, however i still have the same behavior, several HCBT_CLICKSKIPPED messages and that's it:

library HookLib;

uses
  SysUtils, Classes, Windows;

  type
  //TClientCallBack = procedure(Code,wParam : integer) of object;

  PSharedRecord = ^TSharedRecord;
  TSharedRecord = record
      fHookhandle: THandle;
      clientHwnd : HWND;
      fInstallProcess: DWORD;
  end;

  var fMemoryFile: THandle = 0;
      sharedRec: PSharedRecord = nil;
      uiMyMsg: UINT = 0;
{$R *.res}

function callbackFunction(Code, wParam, lParam: Integer): Integer; stdcall;
begin

      if Code >= 0 then begin
      OutputDebugString(PChar('code from dll' + InttoStr(Code)));
      if sharedRec <> nil then begin
         PostMessage(sharedRec^.clientHwnd, uiMyMsg, Code, wParam);

      end;
  end;
      result := CallNextHookEx(sharedRec^.fHookhandle, Code, wParam, lParam);
     
end;


function InstallCBTHook(clientHwnd : HWND): boolean ; stdcall;
begin

 result := false;
  fMemoryFile := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE,0,                   // size: high 32-bits
                SizeOf(TSharedRecord), 'auniquename');

      if (fMemoryFile <> 0 ) then begin
    sharedRec := MapViewOfFile(fMemoryFile, FILE_MAP_ALL_ACCESS, 0, 0, 0);
    if sharedRec <> nil then begin
        sharedRec^.clientHwnd := clientHwnd ;
        sharedRec^.fInstallProcess := GetCurrentProcessId;
             sharedRec^.fHookhandle := SetWindowsHookEx(WH_CBT, @callbackFunction, hInstance, 0);

        result := true ;
    end;
  end
  else  result := false;


end;

procedure UninstallCBTHook();stdcall;
begin
  if assigned(sharedRec) then begin
    if sharedRec^.fInstallProcess = GetCurrentProcessId then begin
      UnhookWindowsHookEx(sharedRec^.fHookhandle);
      sharedRec^.fHookhandle := 0;
      sharedRec^.clientHwnd := 0;
      sharedRec^.fInstallProcess := 0;
    end;
    UnmapViewOfFile(sharedRec);
    sharedRec := nil;
  end;
  if (fMemoryFile <> 0 ) then begin
     CloseHandle(fMemoryFile);
     fMemoryFile := 0;
  end;

end;

procedure DllEntry(dwReason : DWORD);
begin
  if (dwReason = Dll_Process_Attach) then begin
      uiMyMsg := RegisterWindowMessage('auniquemsgname');

       if uiMyMsg <> 0 then begin
          fMemoryFile := OpenFileMapping(FILE_MAP_WRITE, False, 'auniquemsgname');
          sharedRec := MapViewOfFile(fMemoryFile, FILE_MAP_READ, 0, 0, 0);
           if sharedRec = nil then UninstallCBTHook();

      end;
  end
  else if (dwReason = Dll_Process_Detach) then begin
      UninstallCBTHook();
   end;
end;

exports
   InstallCBTHook, UninstallCBTHook, callbackFunction;

begin
  DisableThreadLibraryCalls(hInstance);
  DllProc := @DLLEntry;
  DllEntry(DLL_PROCESS_ATTACH);

end.
0
 
Computer101Commented:
Forced accept.

Computer101
EE Admin
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now