请大家探讨一下delphi编写的钩子程序,究竟有没有稳定的?!是delhpi的bug吗? 这里有一个原码例子的钩子经常引起EXPLORER.EXE非法操作和机器

请大家探讨一下delphi编写的钩子程序,究竟有没有稳定的?!是delhpi的bug吗? 这里有一个原码例子的钩子经常引起EXPLORER.EXE非法操作和机器死机?(100分)<br />这是我从“深度历险”中下载的钩子，在使用中随机引起各种程序其中最多
是EXPLORER。EXE、IE、和自已非法操作并弹出相关程序的“非法操作”窗口而关
闭，有时关闭这个窗口后死机，且是随机的出现，很不稳定。请大家探讨一下,问题出在
何处?

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&gt;=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&lt;=0) and (ShellHook&lt;&gt;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&lt;=0) and (KeyHook&lt;&gt;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&lt;=0) and (MouseHook&lt;&gt;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&gt;0) or (KeyCount&gt;0) or (MouseCount&gt;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有bug.

应该是delphi的问题。。。用vc++或bcb写都没有问题。。。

同意，应该是DELPHI的问题。

那用delphi就没办法了吗?

&gt;&gt;

谁有稳定的源代码，加分加分！！！！

哎呀,用VC写钩子程序的动态连接库不就搞定了吗?很简单的!调用钩子函数在DELPHI/VB/VC等
都好使用,应该很稳定的!

pay attention

多人接受答案了。