这是我从“深度历险”中下载的钩子，在使用中随机引起各种程序其中最多(200分)

这是我从“深度历险”中下载的钩子，在使用中随机引起各种程序其中最多
是EXPLORER。EXE、IE、和自已非法操作并弹出相关程序的“非法操作”窗口而关
闭，有时关闭这个窗口后死机，且是随机的出现，很不稳定。请大家探讨一下,问题出在
何处?已讨论过，都说是delphi的BUG，用VC、BCB就没问题。VC和BCD我不懂，请各位用VC
和BCD作成DLL寄给我供DELPHI使用，我来测试一下是否有问题。我的E-MAIL:jingzu@netease.com
谢谢！
library Watchdll;
{
Code for the watchdll.dll needed for the component TWatch.
Note that system-wide watching is *not* possible without
a dll. That's a limitation of Windows.
This is NOT Freeware: It's PostCardWare. When you use
this component or think it's useful, send me a post-card
to (this is my parents' address, it will always reach me
Florian B鰉ers
Colmarer Str.11
28211 Bremen
GERMANY
And of course, I am very interested in any application
that uses this dll (or any other application you wrote).
If so, mail me (not the program, just an URL or similar) !
(c) 1997-2000 by Florian B鰉ers
(using memory files: seen in c't 07/1997)
send any comments, proposals, enhancements etc. to:
delphi@bome.com
file history (history started 17 Dec 1999):
17 Dec 1999: - mouse hook added by David Hessler
- changed SetReceiver to only allow one
instance using the hook
- changed all "BOME" names to "WATCH" and changed the name
of the dll to watchdll.dll because some virus
scanners detected watching.dll as a virus.
}
uses Windows {$ifdef DEBUG}, SysUtils {$endif} ;
const
MSG_WATCH_SHELL_EVENT='WATCH_SHELL_EVENT';
MSG_WATCH_KEY_EVENT='WATCH_KEY_EVENT';
MSG_WATCH_MOUSE_EVENT='WATCH_MOUSE_EVENT';

HookMemFileName='WatchHook.DTA';
HookMutexName='WatchHookMutex';
type
TWatchType=( wtSHELL,wtKEYBOARD, wtMOUSE, //implemented
wtCALLWNDPROC,wtGETMESSAGE, //not yet implemented
wtMSGFILTER,wtSYSMSGFILTER);
//not yet implemented
TShared = record
ShellHook:HHook;
ShellCount:Integer;
KeyHook:HHOOK;
KeyCount:Integer;
MouseHook:HHOOK;
MouseCount:Integer;
Receiver:Integer;
AttachCount:Integer;
end;
PShared=^TShared;
var
SHELL_EVENT:Integer;
KEY_EVENT:Integer;
MOUSE_EVENT:Integer;
MemFile, HookMutex: THandle;
Shared: PShared;
{------------ Hook procedures ------------------}
// Callback of the Shell Hook
function GetShellHook( Code: Integer;
// hook code
wParam: WPARAM;
// event-specific information
lParam:LPARAM // undefined
): LRESULT;
stdcall;
begin
WaitForSingleObject(HookMutex,INFINITE);
try
if Code>=0 then
begin
// send the Code as lParam
PostMessage(Shared^.Receiver,SHELL_EVENT,wParam,Code);
end;
Result:=CallNextHookEx(Shared^.ShellHook, Code, wParam, lParam);
finally
ReleaseMutex(HookMutex);
end;
end;

// Callback of the Keyboard Hook
function GetKeyHook( Code: Integer;
// hook code
wParam: WPARAM;
// virtual-key code
lParam:LPARAM // keystroke-message information
):LRESULT;
stdcall;
begin
WaitForSingleObject(HookMutex,INFINITE);
try
if code=HC_ACTION then
PostMessage(Shared^.Receiver,KEY_EVENT,wParam,lParam);
Result:=CallNextHookEx(Shared^.KeyHook, Code, wParam, lParam);
finally
ReleaseMutex(HookMutex);
end;
end;

// Callback of the Mouse Hook
function GetMouseHook(Code:Integer;
// hook code
wParam:WPARAM;
// message identifier
lParam:LPARAM // mouse coordinates
):LRESULT;
stdcall;
begin
WaitForSingleObject(HookMutex,INFINITE);
try
if code=HC_ACTION then
begin
// send the mouse position as a packed 32-bit value
// we lose the non-client area hit test info
// and which window would receive this message.
with PMouseHookStruct(lParam)^do
PostMessage(Shared^.Receiver,MOUSE_EVENT, wParam, (pt.x and $FFFF) or (pt.y shl 16));
end;

Result:=CallNextHookEx(Shared^.MouseHook, Code, wParam, lParam);
finally
ReleaseMutex(HookMutex);
end;
end;

{----------------Procedures called by TWatch component----------------}
// starts watching on this type
// For every call there must be a matching StopWatching call
// or at the end a StopAll.
procedure StartWatching(WatchType:TWatchType);
stdcall;
begin
WaitForSingleObject(HookMutex,INFINITE);
try
with Shared^do
case WatchType of
wtSHELL:
begin
if (ShellCount=0) and (ShellHook=0) then
begin
{$ifdef DEBUG}
OutputDebugString(PChar('Shell hook set.'));
{$endif}
ShellHook:=SetWindowsHookEx(WH_SHELL, @GetShellHook, HInstance , 0);
end;
inc(ShellCount);
{$ifdef DEBUG}
OutputDebugString(PChar('ShellCount='+IntToStr(ShellCount)));
{$endif}
end;
wtKEYBOARD:
begin
if (KeyCount=0) and (KeyHook=0) then
begin
{$ifdef DEBUG}
OutputDebugString(PChar('Keyboard Hook set.'));
{$endif}
KeyHook:=SetWindowsHookEx(WH_KEYBOARD, @GetKeyHook, HInstance , 0);
end;
inc(KeyCount);
{$ifdef DEBUG}
OutputDebugString(PChar('KeyCount='+IntToStr(KeyCount)));
{$endif}
end;
wtMOUSE:
begin
if (MouseCount=0) and (MouseHook=0) then
begin
{$ifdef DEBUG}
OutputDebugString(PChar('Keyboard Hook set.'));
{$endif}
MouseHook:=SetWindowsHookEx(WH_MOUSE, @GetMouseHook, HInstance , 0);
end;
inc(MouseCount);
{$ifdef DEBUG}
OutputDebugString(PChar('MouseCount='+IntToStr(MouseCount)));
{$endif}
end;
end;
finally
ReleaseMutex(HookMutex);
end;
end;

// stops this type of watch
procedure StopWatching(WatchType:TWatchType);
stdcall;
begin
WaitForSingleObject(HookMutex,INFINITE);
try
with Shared^do
case WatchType of
wtSHELL:
begin
dec(ShellCount);
if (ShellCount<=0) and (ShellHook<>0) then
begin
UnhookWindowsHookEx(ShellHook);
ShellHook:=0;
{$ifdef DEBUG}
OutputDebugString(PChar('Shell unhooked.'));
{$endif}
end;
if ShellHook=0 then
ShellCount:=0;
end;
wtKEYBOARD:
begin
dec(KeyCount);
if (KeyCount<=0) and (KeyHook<>0) then
begin
UnhookWindowsHookEx(KeyHook);
KeyHook:=0;
{$ifdef DEBUG}
OutputDebugString(PChar('Keyboard unhooked.'));
{$endif}
end;
if KeyHook=0 then
KeyCount:=0;
end;
wtMOUSE:
begin
dec(MouseCount);
if (MouseCount<=0) and (MouseHook<>0) then
begin
UnhookWindowsHookEx(MouseHook);
MouseHook:=0;
{$ifdef DEBUG}
OutputDebugString(PChar('Mouse unhooked.'));
{$endif}
end;
if MouseHook=0 then
MouseCount:=0;
end;
end;
finally
ReleaseMutex(HookMutex);
end;
end;

// frees all Hooks
procedure StopAll;
stdcall;
var alreadyStopped:Boolean;
begin
WaitForSingleObject(HookMutex,INFINITE);
try
with Shared^do
begin
alreadyStopped:=((ShellCount=0) and (KeyCount=0) and (MouseCount=0));
ShellCount:=0;
KeyCount:=0;
MouseCount:=0;
end;
finally
ReleaseMutex(HookMutex);
end;
if not alreadyStopped then
begin
StopWatching(wtSHELL);
StopWatching(wtKEYBOARD);
StopWatching(wtMOUSE);
end;
end;

// returns, whether any Hooks are installed
function StillWatching:Boolean;
stdcall;
begin
WaitForSingleObject(HookMutex,INFINITE);
try
with Shared^do
result:=(ShellCount>0) or (KeyCount>0) or (MouseCount>0);
finally
ReleaseMutex(HookMutex);
end;
end;

{ Sets the Window Handle of the Window that will receive the messages
Returns, whether it was successful.
An application should set the receiver to 0 when finished.
note: This prevents that this dll is used in multiple instances.
Only the first program that called SetReceiver will receive
the events.
TODO: List of receivers...
}
function SetReceiver(R:THandle):Boolean;
stdcall;
begin
WaitForSingleObject(HookMutex,INFINITE);
try
result:=(r=0) or (Shared^.Receiver=0);
if result then
begin
Shared^.Receiver:=r;
{$ifdef DEBUG}
OutputDebugString(PChar('Receiver set to $'+IntToHex(r,2)));
{$endif}
end;
finally
ReleaseMutex(HookMutex);
end;
end;

function GetReceiver:THandle;
stdcall;
begin
WaitForSingleObject(HookMutex,INFINITE);
try
result:=Shared^.Receiver;
finally
ReleaseMutex(HookMutex);
end;
end;

procedure Intro;
stdcall;
begin
// called everytime when the dll is injected into another context
SHELL_EVENT:=RegisterWindowMessage(PChar(MSG_WATCH_SHELL_EVENT));
KEY_EVENT:=RegisterWindowMessage(PChar(MSG_WATCH_KEY_EVENT));
MOUSE_EVENT:=RegisterWindowMessage(PChar(MSG_WATCH_MOUSE_EVENT));
HookMutex:=CreateMutex(nil,True,HookMutexName);
MemFile:=OpenFileMapping(FILE_MAP_WRITE,False,HookMemFileName);
if MemFile=0 then
MemFile:=CreateFileMapping($FFFFFFFF,nil,
PAGE_READWRITE,0,SizeOf(TShared),HookMemFileName);
Shared:=MapViewOfFile(MemFile,FILE_MAP_WRITE,0,0,0);
if MemFile=0 then
FillChar(Shared^,SizeOf(TShared),0);
inc(Shared^.AttachCount);
ReleaseMutex(HookMutex);
end;

procedure Extro;
stdcall;
var fini:Boolean;
begin
try
WaitForSingleObject(HookMutex,INFINITE);
dec(Shared^.AttachCount);
fini:=(Shared^.AttachCount=0);
finally
ReleaseMutex(HookMutex);
end;
if fini then
begin
StopAll;
UnmapViewOfFile(Shared);
CloseHandle(MemFile);
CloseHandle(HookMutex);
end;
end;

{------------- DLL Entry ----------------}
procedure DLLEntryPoint(reason:integer);
begin
case reason of
0: {DLL_PROCESS_DETACH} Extro;
1: {DLL_PROCESS_ATTACH} Intro;
// 2: {DLL_THREAD_ATTACH}
// 3: {DLL_THREAD_DETACH}
end;
end;

exports
StartWatching,
StopWatching,
StopAll,
StillWatching,
SetReceiver,
GetReceiver;
begin
Intro;
DLLProc:=@DLLEntryPoint;
end.




--------------------------------------------------------------------------------

我也用过这个控件,没有引起非法操作,但它常失灵. 写钩子都要用内存影射,和线程同步吗?

可能与delphi的版本有关。

没有人回答，我把分收回了。

可能是delphi和winapi的一些类型转换发生了问题。

多人接受答案了。