这是一个屏幕取词的DLL代码:
library dll_HookMouse;
uses
SysUtils,
Windows,
Classes,
Messages,
Math,
Dialogs,
U_Def in 'U_Def.pas';
{$R *.RES}
var
hMouseHook : HHOOK;
SpyInstalled : Boolean;
fTimerID : Cardinal;
pShMem : PShareMem;
hMappingFile : THandle;
function InstallSpy:Boolean;
forward;
function UnWiseSpy:Boolean;
forward;
function fExtTextOutA(theDC :HDC;
nXStart, nYStart :integer;
toOptions : Lon
gint;
rect : PRect;
lpStr
AnsiChar;
nCount :Longint;
Dx: PInteger):BOOL;
stdcall;
var
dwBytes, dwCallingProc : DWORD;
pOldExtTextOut : _ExtTextOutA;
hModuleGDI : THandle;
poOri, poDC, poText, poMouse : TPoint;
Size : TSize;
begin
UnWiseSpy;
GetWindowThreadProcessID(pShMem^.hHookWnd, @dwCallingProc);
try
if pShMem^.bCanSpyNow and (dwCallingProc <> pShMem^.hProc) then
begin
dwBytes := Min(nCount, MaxStringLen);
CopyMemory(@(pShMem^.fStrExtTextOutA), lpStr, dwBytes);
//Get lpStr Content
//The following codes for get the right text
GetDCOrgEx(theDC, poOri);
// 取得本窗口设备相关坐标原点的全局逻辑坐标
poDC.x := nXStart;
poDC.y := nYStart;
//
LPToDP(theDC, poDC, 1);
//全局逻辑坐标转化为设备相关坐标
GetCursorPos(poMouse);
poText.x := poDC.x + poOri.x;
poText.y := poDC.y + poOri.y;
if (GetTextAlign(theDC) and TA_UPDATECP) <> 0 then
begin
GetCurrentPositionEx(theDC, @poOri);
poText.x := poText.x + poOri.x;
poText.y := poText.y + poOri.y;
end;
GetTextExtentPoint(theDC, lpStr, nCount, Size);
// 取得要输出的字符串的实际显示大小
if (poMouse.x >= poText.x) and (poMouse.x <= poText.x + Size.cx) and
(poMouse.y >= poText.y) and (poMouse.y <= poText.y + Size.cy) then
begin
pShMem^.bCanSpyNow := False;
pShMem^.nTimePassed := -1;
end;
pShMem^.fStrExtTextOutA[dwBytes] := Chr(0);
FlushViewOfFile(pShMem, 0);
if dwCallingProc <> pShMem^.hProc then
PostMessage(pShMem^.hProcWnd, WM_MOUSEPT, 2, 2);
end;
if (dwCallingProc = pShMem^.hProc) or pShMem^.bHookExtTextOutA then
begin
hModuleGDI := GetModuleHandle(PChar('GDI32'));
@pOldExtTextOut := GetProcAddress(hModuleGDI, PChar('ExtTextOutA'));
Result := pOldExtTextOut(theDC, nXStart, nYStart, toOptions, rect, lpS
tr, nCount, Dx);
end else
Result := True;
except
Result := False;
end;
SpyInstalled := True;
InstallSpy;
end;
function UnWiseSpy:Boolean;
var
dwBytesWritten, dwOldProtect : DWORD;
pOldExtTextOut : _ExtTextOutA;
hModuleGDI : THandle;
begin
hModuleGDI := GetModuleHandle(PChar('GDI32'));
@pOldExtTextOut := GetProcAddress(hModuleGDI, PChar('ExtTextOutA'));
if not VirtualProtect(@pOldExtTextOut, SizeOf(TLongJump), PAGE_EXECUTE_REA
DWRITE, @dwOldProtect) then
begin
Result := False;
Exit;
end;
if not WriteProcessMemory(GetCurrentProcess, @pOldExtTextOut, @pShMem^.pOl
dExtTextOutA, SizeOf(TLongJump), dwBytesWritten) then
begin
Result := False;
Exit;
end;
if not VirtualProtect(@pOldExtTextOut, SizeOf(TLongJump), dwOldProtect, @d
wBytesWritten) then
begin
Result := False;
Exit;
end;
Result := True;
end;
function InstallSpy:Boolean;
var
dwBytesWritten, dwOldProtect : DWORD;
ljHere : TLongJump;
pOldExtTextOut : _ExtTextOutA;
hModuleGDI : THandle;
begin
hModuleGDI := GetModuleHandle(PChar('GDI32'));
@pOldExtTextOut := GetProcAddress(hModuleGDI, PChar('ExtTextOutA'));
if not VirtualProtect(@pOldExtTextOut, SizeOf(TLongJump), PAGE_EXECUTE_REA
DWRITE, @dwOldProtect) then
begin
Result := False;
Exit;
end;
ljHere.JmpOp := CodeJump;
ljHere.Addr := Pointer( Cardinal(@fExtTextOutA) - Cardinal(@pOldExtTextOut
) - SizeOf(TLongJump) );
if not WriteProcessMemory(GetCurrentProcess, @pOldExtTextOut, @ljHere, Siz
eOf(TLongJump), dwBytesWritten) then
begin
Result := False;
Exit;
end;
if not VirtualProtect(@pOldExtTextOut, SizeOf(TLongJump), dwOldProtect, @d
wBytesWritten) then
begin
Result := False;
Exit;
end;
Result := True;
end;
function MouseHookProc(nCode : integer;
wPar : WParam;
lPar : LParam) : lRes
ult;
stdcall;
var
pMouseInf : TMouseHookStruct;
begin
if (not SpyInstalled) and pShMem^.bHookExtTextOutA then
InstallSpy;
if SpyInstalled and (not pShMem^.bHookExtTextOutA) then
begin
UnwiseSpy;
SpyInstalled := False;
end;
pShMem^.nTimePassed := 0 ;
if (nCode >= 0) and (wPar = WM_MOUSEMOVE) then
begin
pMouseInf := (PMouseHookStruct(lPar))^;
if (pShMem^.pMouse.x <> pMouseInf.pt.x) or
(pShMem^.pMouse.y <> pMouseInf.pt.y) then
begin
if nCode = HC_NOREMOVE then
pShMem^.fStrMouseQueue := 'Not removed from the queue'
else
//then
HC_ACTION
pShMem^.fStrMouseQueue := 'Removed from the queue';
pShMem^.pMouse := pMouseInf.pt;
pShMem^.hHookWnd := pMouseInf.hwnd;
PostMessage(pShMem^.hProcWnd, WM_MOUSEPT, 1, 1);
//1 indicates mouse m
essage
end;
end;
FlushViewOfFile(pShMem, 0);
Result := CallNextHookEx(hMouseHook, nCode, wPar, lPar);
end;
procedure fOnTimer(theWnd : HWND;
msg, idTimer : Cardinal;
dwTime : DWORD);f
ar pascal;
//CallBack Type
begin
if pShMem^.nTimePassed = -1 then
Exit;
pShMem^.nTimePassed := pShMem^.nTimePassed + 1;
if pShMem^.nTimePassed > 21 then
begin
pShMem^.nTimePassed := 21;
FlushViewOfFile(pShMem, 0);
Exit;
end;
if pShMem^.nTimePassed > 20 then
begin
pShMem^.bCanSpyNow := True;
FlushViewOfFile(pShMem, 0);
SetWindowPos(pShMem^.hWndPseudo, HWND_TOPMOST, pShMem^.pMouse.x, pShMem^
.pMouse.y, 1, 8, SWP_NOACTIVATE or SWP_SHOWWINDOW);
ShowWindow(pShMem^.hWndPseudo , SW_HIDE);
end;
end;
function MouseWndProc(theWnd : HWND;
theMess : Cardinal;
wPar : wParam;
lPar
: lParam): LResult;stdcall;
begin
case theMess of
WM_CLOSE :
begin
DestroyWindow(theWnd);
PostQuitMessage(0);
end;
else
begin
Result := DefWindowProc(theWnd, theMess, wPar, lPar);
Exit;
end;
end;
Result := 0;
end;
function InstallMouseHook(hInst : LongWord):Boolean;
begin
hMouseHook := SetWindowsHookEx(WH_MOUSE,
MouseHookProc,
GetModuleHandle(PChar('dll_HookMouse')),
0);
if hMouseHook = 0 then
begin
Result := False;
Exit;
end;
pShMem^.hWndPseudo := CreateWindowEx(WS_EX_TOPMOST or WS_EX_TOOLWINDOW,
'ZL_MOUSE_WND_PSEUDO',
'ZL_MOUSE_WND_PSEUDO',
WS_CLIPSIBLINGS or WS_POPUP ,
0, 0, 1, 8,
0, 0,
hInst,
nil);
ShowWindow(pShMem^.hWndPseudo, SW_HIDE);
UpdateWindow(pShMem^.hWndPseudo);
fTimerID := SetTimer(0, 0, 10, @fOnTimer);
FlushViewOfFile(pShMem, 0);
Result := True;
end;
function UnWiseMouseHook:Boolean;
begin
KillTimer(0, fTimerID);
DestroyWindow(pShMem^.hWndPseudo);
if SpyInstalled then
UnWiseSpy;
pShMem^.bHookExtTextOutA := False;
FlushViewOfFile(pShMem, 0);
Result := UnHookWindowsHookEx(hMouseHook);
end;
procedure DllEntry(nReason : integer);
begin
case nReason Of
DLL_PROCESS_ATTACH:
begin
hMappingFile := CreateFileMapping($FFFFFFFF,
nil,
PAGE_READWRITE,
0,
SizeOf(TShareMem),
PChar(MappingFileName));
if hMappingFile<>0 then
//if h..=0 , the work isdo
ne by OS
begin
pShMem := PShareMem( MapViewOfFile(hMappingFile,
FILE_MAP_WRITE,
0, //hi_order offset where mapp
ing begin
s
0, //lo_order offset where mapp
ing begin
s
0) );
//Size of the mapping
if pShMem = nil then
begin
CloseHandle(hMappingFile);
ShowMessage('Cannot create the Share Memory Block!');
end;
end else
ShowMessage('Cannot create the Share Memory Block!');
end;
DLL_PROCESS_DETACH:
begin
UnwiseSpy;
UnMapViewOfFile(pShMem);
CloseHandle(hMappingFile);
end;
else
;
end;
end;
exports
MouseWndProc,
InstallMouseHook,
UnWiseMouseHook;
begin
DllProc := @DllEntry;
DllEntry(DLL_PROCESS_ATTACH);
end.
-------------- ----------------
下面是dll的接口文件:
unit U_Def;
interface
uses
Messages, Windows;
const
WM_MOUSEPT = WM_USER + 1000 + Ord('M') + Ord('P') + Ord('T');
MappingFileName = 'Mapping File By Raphael';
MaxStringLen = 50;
CodeJump = $E9909090;
type
PInt = ^integer;
_ExtTextOutA = function (theDC :HDC;
nXStart, nYStart :integer;
toOptions
: Longint;
rect : PRect;
lpStr
AnsiChar;
nCount :integer;
Dx : PInteger)
:BOOL;
stdcall;
_PExtTextOutA = ^_ExtTextOutA;
TLongJump = packed record
JmpOp : Cardinal;
Addr : Pointer;
end;
TShareMem = packed record
hProcWnd : HWND;
//The main window of the program
hHookWnd : HWND;
//The window currently being hooked
hWndPseudo : HWND;
//The pseudo window used to repaint the other
window
hProc : THandle;
//The process ID of the main program
pMouse : TPoint;
//the mouse position
fStrMouseQueue : array [0..MaxStringLen] of Char;
//mouse info
nTimePassed : integer;
//the time passed since last time's mousemove
bCanSpyNow : Boolean;
bHookExtTextOutA : Boolean;
pOldExtTextOutA : TLongJump;
fStrExtTextOutA : array [0..MaxStringLen] of Char;
end;
PShareMem = ^TShareMem;
implementation
end.
--------------------
下面是主窗体文件:
unit U_MouseHook;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, U_Def;
type
TF_MouseHook = class(TForm)
Label1: TLabel;
e_MouseInfo: TEdit;
btn_HookMouse: TButton;
Label2: TLabel;
e_ExtTextOutA: TEdit;
btn_HookExtTextOutA: TButton;
procedure btn_HookMouseClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure btn_HookExtTextOutAClick(Sender: TObject);
private
fWndClosed, fbMouseHookInstalled : Boolean;
hMapObj : THandle;
pShMem : PShareMem;
procedure getMouseInfo(var theMess:TMessage);
message WM_MOUSEPT;
public
{ Public declarations }
end;
function InstallMouseHook(hInst : LongWord) : Boolean;
external 'dll_HookMouse.dll';
function UnWiseMouseHook : Boolean;
external 'dll_HookMouse.dll';
function MouseWndProc(theWnd : HWND;
theMess : Cardinal;
wPar : wParam;
lPar : lParam): LResult;
stdcall;
external 'dll_HookMouse.dll';
var
F_MouseHook: TF_MouseHook;
implementation
{$R *.DFM}
procedure TF_MouseHook.btn_HookMouseClick(Sender: TObject);
begin
if not fbMouseHookInstalled then
begin
fbMouseHookInstalled := InstallMouseHook(hInstance);
if fbMouseHookInstalled then
begin
btn_HookMouse.Caption := 'Stop!';
btn_HookExtTextOutA.Enabled := True;
end else
ShowMessage('Cannot hook mouse!');
end else
begin
fbMouseHookInstalled := not UnWiseMouseHook;
if not fbMouseHookInstalled then
begin
btn_HookMouse.Caption := 'Hook Mouse';
btn_HookExtTextOutA.Enabled := False;
btn_HookExtTextOutA.Caption := 'Hook ExtTextOutA';
pShMem^.bHookExtTextOutA := False;
FlushViewOfFile(pShMem, 0);
end else
ShowMessage('Cannot unhook mouse!');
end;
end;
procedure TF_MouseHook.getMouseInfo(var theMess : TMessage);
begin
if fWndClosed then
Exit;
if theMess.LParam = 1 then
//Get the Mouse info to display
e_MouseInfo.Text := 'X:' + IntToStr(pShMem^.pMouse.x) + ' ' +
'Y:' + IntToStr(pShMem^.pMouse.y) + ' ' +
'HWND:0x' + IntToHex(pShMem^.hHookWnd, 8) + ' ' +
pShMem^.fStrMouseQueue
else
if theMess.LParam = 2 then
//Get the ExtTextOutA display
e_ExtTextOutA.Text := pShMem^.fStrExtTextOutA;
end;
procedure TF_MouseHook.FormCreate(Sender: TObject);
var
hModuleGDI : THandle;
wc : TWndClass;
begin
hMapObj := OpenFileMapping(FILE_MAP_WRITE, //Get full access of the mapping file
False, //Not inheritable
LPCTSTR(MappingFileName));
//Name of the mapping file
if hMapObj = 0 then
begin
ShowMessage('Cannot locate the Share Memory Block!');
Halt;
end;
pShMem := PShareMem( MapViewOfFile(hMapObj,
FILE_MAP_WRITE,
0, //hi_order offset where mapping begin
s
0, //lo_order offset where mapping begin
s
0) );
//Size of the mapping
if pShMem = nil then
begin
ShowMessage('Map File Mapping Failed! Error '+ IntToStr(GetLastError));
CloseHandle(hMapObj);
Halt;
end;
FillChar(pShMem^, SizeOf(TShareMem), 0);
hModuleGDI := GetModuleHandle(PChar('GDI32'));
if hModuleGDI = 0 then
begin
ShowMessage('Cannot get module GDI32! Error ' + IntToStr(GetLastError));
UnmapViewOfFile(pShMem);
CloseHandle(hMapObj);
Halt;
end;
CopyMemory(@pShMem^.pOldExtTextOutA, GetProcAddress(hModuleGDI, PChar('ExtTextOutA')), SizeOf(TLongJump));
pShMem^.hProcWnd := Self.Handle;
GetWindowThreadProcessID(Self.Handle, @pShMem^.hProc);
pShMem^.bHookExtTextOutA := False;
pShMem^.bCanSpyNow := False;
fbMouseHookInstalled := False;
FlushViewOfFile(pShMem, 0);
wc.style := 0;
wc.lpfnWndProc := TFNWndProc(@MouseWndProc);
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
wc.hInstance := HInstance;
wc.hIcon := 0 ;
wc.hCursor := 0 ;
wc.hbrBackground := 0 ;
wc.lpszMenuName := nil;
wc.lpszClassName := 'ZL_MOUSE_WND_PSEUDO';
// register the class for the main window
Windows.RegisterClass(wc);
fWndClosed := False;
end;
procedure TF_MouseHook.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
if fbMouseHookInstalled then
UnWiseMouseHook;
UnMapViewOfFile(pShMem);
CloseHandle(hMapObj);
Windows.UnRegisterClass('ZL_MOUSE_WND_PSEUDO', hInstance);
fWndClosed := True;
end;
procedure TF_MouseHook.btn_HookExtTextOutAClick(Sender: TObject);
begin
if pShMem^.bHookExtTextOutA then
btn_HookExtTextOutA.Caption := 'Hook ExtTextOutA'
else
btn_HookExtTextOutA.Caption := 'Stop!';
pShMem^.bHookExtTextOutA := not pShMem^.bHookExtTextOutA;
FlushViewOfFile(pShMem, 0);
end;
//RaiseLastWin32Error can be used to create a GetLastError
//Message
end.