shellhk.dpr

这一系列是我平时收集的pascal深入核心编程

library ShellHk;

uses Windows, Messages;

type
 // 共享内存结构
  PShareMem = ^TShareMem;
  TShareMem = record
    g_hhook: HHOOK; // ShellHook句柄
    g_hwndListBox: HWND; // Listbox句柄
  end;

const
 // 内存映射文件名
  SHARE_NAME = 'ShellHook_Shared';

var
 // 内存映射文件句柄
  FileMap: THandle;

 // 内存映射文件地址
  PShared: PShareMem;

  
 // 外壳钩子回调函数 
function ShellHook_HookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  sz, szPath: array[0..128] of Char;
  dwProcessID: DWORD;
  hWnd: LongWord; // HWND
  dwThreadID: DWORD;
  ArgList: array[1..4] of Integer;
begin
 // 调用下一个Shell钩子
  Result := CallNextHookEx(PShared.g_hhook, nCode, wParam, lParam);

  case (nCode) of
    HSHELL_WINDOWCREATED,   // 窗口建立
    HSHELL_WINDOWDESTROYED: // 窗口销毁
      begin
       // 窗口句柄及其隶属的线程/进程
        hWnd := wParam;
        dwThreadID := GetWindowThreadProcessId(hWnd, @dwProcessID);

       // 取钩子DLL所处进程的完整路径
        if GetModuleFileName(0, szPath, SizeOf(szPath)) = 0 then
          szPath := '<unknown>';

       // 作格式化转换,结果存入sz数组
        if (nCode = HSHELL_WINDOWCREATED) then
          ArgList[1] := Integer('>')
        else
          ArgList[1] := Integer('<');
        ArgList[2] := dwProcessID;
        ArgList[3] := dwThreadID;
        ArgList[4] := Integer(@szPath[1]);
        wvsprintf(sz, '%c pid=0x%08x, tid=0x%08x, path=%s', @ArgList[1]);

       // 结果字符串追加到ListBox控件
        SendMessage(PShared.g_hwndListBox, LB_ADDSTRING, 0, Integer(@sz[0]));
      end;
  end;
end;

 // 安装钩子
function ShellHook_Start(hWndListBox: HWND): BOOL; stdcall;
var
  hhook: LongWord; // HHOOK
begin
 // 已经安装
  if (PShared.g_hhook <> 0) then
  begin
    Result := FALSE;
    Exit;
  end;

 // 修改句柄 
  PShared.g_hwndListBox := hWndListBox;

 // 使得下面语句被打断的概率变小
  Sleep(0);

 // 安装钩子
  hhook := SetWindowsHookEx(WH_SHELL, @ShellHook_HookProc, HInstance, 0);

 // 保证同步
  InterlockedExchange(Integer(PShared.g_hhook), Integer(hhook));

 // 是否成功
  Result := PShared.g_hhook <> 0;
end;

 // 卸载钩子
function ShellHook_Stop(): BOOL; stdcall;
begin
 // 已经安装
  if (PShared.g_hhook <> 0) then
  begin
    Result := UnhookWindowsHookEx(PShared.g_hhook);
    PShared.g_hhook := 0;
  end else
    Result := TRUE;
end;

  // DLL回调
procedure DLLMain(dwReason: DWORD);
begin
  if (dwReason = DLL_PROCESS_DETACH) then
  begin
    UnmapViewOfFile(PShared);
    CloseHandle(FileMap);
  end;
end;

 // 导出函数
exports
  ShellHook_Start,
  ShellHook_Stop;

 // DLL入口点
begin
 // 设置回调
  DllProc := @DLLMain;

 // 尝试打开
  FileMap := OpenFileMapping(FILE_MAP_ALL_ACCESS, FALSE, SHARE_NAME);

 // 还未建立  
  if (FileMap = 0) then
  begin
    FileMap :=
      CreateFileMapping(DWORD(-1), nil, PAGE_READWRITE, 0, SizeOf(TShareMem), SHARE_NAME);
    PShared := MapViewOfFile(FileMap, FILE_MAP_ALL_ACCESS, 0, 0, 0);
    
    ZeroMemory(PShared, SizeOf(TShareMem));
  end else
    PShared := MapViewOfFile(FileMap, FILE_MAP_ALL_ACCESS, 0, 0, 0);
end.