delphi runtime 216错误(100分)

我用vtoolsd 写了一个vxd,用delphi写了一个dll和exe，exe文件运行后
放在tray area，这套程序有一个问题，就是运行时不定时，很偶然地出现
runtime 216错误，后面还有一个错误地址，但这个地址不是段：偏移，而
是只有"00004d29"这样几个字。
请问这个问题是如何发生的，怎样找到问题在哪里？谢!

216 Access violation
可能是你得DLL中访问地址出错！

Oh，我以前也常碰到这个问题！
给我的感觉是，程序和 DLL 之间尽量不要传递类的实例，
而通过其他的方法去实现某个功能

DLL是一个keyboard hook，用来捕获一些特殊的键，
而这个程序原来我引用的是32 bit delphi深度历险
中的一个keyhook的例子，只是在其中加了一些判断
key的代码。如果哪位高手愿意帮我看一看问题在哪里，
我可以将源码寄给他。拜托。老板天天在追我。

看看这里吧：
http://www.gislab.ecnu.edu.cn/delphibbs/DispQ.asp?LID=202446

我看了沈先生的解答，晚上我试验一下。我这两天都在
想办法解决这个问题，但不得其解。我根据delphi的帮助
在我的程序里面放了一些try ... except程序，想看一下
到底是哪里的问题，但在测试中，没有任何地方说有错，
而且，当最开始显示runtime error 216 等错误时，正在运行或
开启的窗口还可以关闭，程序甚至也可以运行（放在tray area)，
但runtime error窗口怎么也关不了，
再过一会系统蓝屏了。delphi4 or 5却都可以正常编译通过。
我在好几台电脑上装了这个程序，有两台经常出现这样的问题。
比如程序运行一段时间尤其是在用IE开了一些窗口的时候。
感谢沈先生的指点。

g

会不会有什么全局的内存或者某些对象没释放？
216假如是16进制的win32api错误的话，意思就是 算术结果超过 32 位

我在编写keyghost-键盘幽灵的时候碰到过此问题,请把源码贴出来
http://sunhy.126.com

这部分是exe的源码
unit main;
interface
uses
sysutils,Windows, Messages, Controls, Forms, Dialogs,
Menus, Fmxutils, StdCtrls, AMixer, shutdown, TBNArea, Classes,
Graphics, ExtCtrls;
type
TMainForm = class(TForm)
Rightmenu: TPopupMenu;
Exit: TMenuItem;
About: TMenuItem;
Scan: TMenuItem;
BigIcon: TMenuItem;
SRTimer: TTimer;
SRImage: TImage;
StatusTimer: TTimer;
Mixer: TAudioMixer;
SoundFormTimer: TTimer;
Shutdown: TShutdown;
Tray: TTBNArea;
procedure ExitClick(Sender: TObject);
procedure ScanClick(Sender: TObject);
procedure AboutClick(Sender: TObject);
procedure hideClick(Sender: TObject);
procedure BigIconClick(Sender: TObject);
procedure SRTimerTimer(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure StatusClick(Sender: TObject);
procedure StatusTimerTimer(Sender: TObject);
procedure SoundFormTimerTimer(Sender: TObject);
procedure SoundClick(Sender: TObject);
procedure GetKeydowncode(var Message:Tmessage);
message wm_keydown;
procedure GetKeyupcode(var Message:Tmessage);
message wm_keyup;
private
{ Private declarations }
public
{ Public declarations }
left:integer;
right:integer;
mute:integer;
VD:boolean;
MD:boolean;
end;

var
MainForm: TMainForm;
ScanFlag:bool;
DisplayIcon:bool;
BGColor: TColor;
hVxD : THandle;
JMECODE,nByte: DWORD;
HwndMainForm:hwnd;
setting: Bool;
havesoundcard:bool;
soundcount : integer;
implementation
uses Status, Sound;
{$R *.DFM}

function EnableHotKeyHook: BOOL;
external 'KeyHook.DLL';
function DisableHotKeyHook: BOOL;
external 'KeyHook.DLL';

procedure TMainForm.ExitClick(Sender: TObject);
begin
DisableHotKeyHook;
Application.Terminate;
end;

procedure TMainForm.ScanClick(Sender: TObject);
begin
if ScanFlag then
begin
showmessage('DisableHotkeyhook!');
DisableHotKeyHook;
Scan.Caption:='Start Scan';
ScanFlag:=False;
end
else
begin
showmessage('EnableHotkeyhook!');
EnableHotKeyHook;
Scan.Caption:='Stop Scan';
ScanFlag:=True;
end;
end;

procedure TMainForm.AboutClick(Sender: TObject);
begin
ShowMessage('JME Hotkey Driver V2.2');
end;

procedure TMainForm.HideClick(Sender: TObject);
begin
MainForm.Hide;
end;

procedure TMainForm.BigIconClick(Sender: TObject);
begin
if not DisplayIcon then
begin
MainForm.Show;
BigIcon.Caption:='Close Icon';
DisplayIcon:=True;
end
else
begin
MainForm.Hide;
BigIcon.Caption:='Display SR';
DisplayIcon:=False;
end;
end;

procedure TMainForm.SRTimerTimer(Sender: TObject);
begin
MainForm.hide;
MainForm.SRTimer.Enabled:=False;
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
MainForm.Brush.Style := bsClear;
MainForm.BorderStyle := bsNone;
ShowWindow(Application.handle,SW_Hide);
MainForm.left:=Screen.Width-Mainform.Width;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
ScanFlag :=True;
Scan.Caption:='Stop Scan';
EnableHotKeyHook;
ShowWindow(Application.handle,SW_Hide);
DisplayIcon:=False;
soundcount:=Mixer.MixerCount;
if (soundcount = 0) then
havesoundcard:=false
else
havesoundcard:=true;
if havesoundcard then
begin
MainForm.Mixer.GetVolume(0, -1, Left, Right, Mute, VD, MD);
if Mute <>0 then
setting := False
else
setting := True;
end;
hVxD := CreateFile('//./c:/progra~1/jmesoft/readkey.vxd' ,0, 0, nil, CREATE_NEW,FILE_FLAG_DELETE_ON_CLOSE,0);
if (hVxD = Invalid_Handle_Value) then
begin
ShowMessage('Can not find hotkey drivers，please re-install!');
Application.Terminate;
end;
hwndMainForm:=Findwindow('TmainForm','Hotkey');
bringwindowtotop(HwndMainForm);
end;

procedure TMainForm.StatusClick(Sender: TObject);
begin
StatusForm.StatusLabel.Caption:='Play';
StatusForm.Show;
end;

procedure TMainForm.StatusTimerTimer(Sender: TObject);
begin
MainForm.StatusTimer.Enabled:=False;
StatusForm.Hide;
end;

procedure TMainForm.SoundFormTimerTimer(Sender: TObject);
begin
MainForm.SoundFormTimer.Enabled:=False;
SoundForm.Hide;
end;

procedure TmainForm.GetKeydowncode(var Message:Tmessage);
begin
//音量降低，显示vol-
try
if ((IntToHex(message.wParam,2) = 'FF') and havesoundcard )then
begin
if (IntToHex(message.lparam and $80FF0000,8) = '00660000') then
begin
MainForm.Mixer.GetVolume(0, -1, Left, Right, Mute, VD, MD);
SoundForm.Width:=(Left div 1638) * 13;
if Left >1456 then
begin
Left := Left - 1638;
MainForm.Mixer.SetVolume(0, -1, Left, -1, 0);
SoundFormTimer.Enabled:=False;
SoundForm.Width:= SoundForm.Width- 13;
SoundForm.Show;
end
else
begin
Left := 0;
MainForm.Mixer.SetVolume(0, -1, Left, -1, 0);
SoundFormTimer.Enabled:=False;
SoundForm.Width:= SoundForm.Width- 13;
SoundForm.Show;
end;
end;
//音量增大，显示vol+
if ((IntToHex(message.lparam and $80FF0000,8) = '00650000') and havesoundcard) then
begin
MainForm.Mixer.GetVolume(0, -1, Left, Right, Mute, VD, MD);
SoundForm.Width:=(Left div 1638) * 13;
if Left < 65535 then
begin
Left := Left +1638;
MainForm.Mixer.SetVolume(0, -1, Left, -1, 0);
SoundForm.Width:=soundForm.Width + 13;
SoundFormTimer.Enabled:=False;
SoundForm.Show;
end
else
begin
Left := 65535;
MainForm.Mixer.SetVolume(0, -1, Left, -1, 0);
SoundForm.Width:=soundForm.Width + 13;
SoundFormTimer.Enabled:=False;
SoundForm.Show;
end;
end;

//显示“VCD”
if (IntToHex(message.lparam and $80FF0000,8) = '006A0000') then
begin
StatusForm.StatusLabel.Caption:='Play VCD';
StatusForm.Show;
end;
//启动强制关机
if (IntToHex(message.lparam and $80FF0000,8) = '00210000') then
begin
ShutDown.Operatingsystem:=shWin95;
ShutDown.Execute;
end;
end;
except
showmessage('There is a error in keydown');
end;
end;

procedure TmainForm.GetKeyupcode(var Message:Tmessage);
var
Filename :string;
HwndVCDkey :hwnd;
begin
try
if (IntToHex(message.wParam,2) = 'FF') then
begin
HWndVCDKey := Findwindow('TFrmcontrol','JMEVCD');
// VCD Player
if (IntToHex(message.lparam and $80FF0000,8) = '806A0000') then
begin
if (HwndVCDKey = 0) then
begin
Filename:='player.lnk';
ExecuteFile(Filename,'','c:/progra~1/jmesoft',1);
end
else
begin
showmessage('The JMEVCD has been running!');
end;
end;
//显示play/pause，如果播放器没有启动则先启动播放器。
if (IntToHex(message.lparam and $80FF0000,8) = '80690000') then
begin
if (HwndVCDKey = 0) then
begin
Filename:='player.lnk';
ExecuteFile(Filename,'','c:/progra~1/jmesoft',1);
end;
HWndVCDKey := Findwindow('TFrmcontrol','JMEVCD');
bringwindowtotop(HwndVCDkey);
keybd_event(VkKeyScan('p'),0,0,0);
keybd_event(VkKeyScan('p'),0,0,keyeventf_keyup);
StatusForm.StatusLabel.Caption:='Pause/Play';
StatusForm.Show;
end;
//设置静音
if (IntToHex(message.lparam and $80FF0000,8) = '80320000') and havesoundcard then
begin
if setting then
begin
StatusForm.StatusLabel.Caption:='Mute On';
StatusForm.Show;
MainForm.Mixer.SetVolume(0, -1, Left, -1, 5);
setting := False;
end
else
begin
StatusForm.StatusLabel.Caption:='Mute Off';
StatusForm.Show;
MainForm.Mixer.SetVolume(0, -1, Left, -1, 0);
setting := True;
end;
end;
//显示Stop/Eject
if (IntToHex(message.lparam and $80FF0000,8) = '806C0000') then
begin
HWndVCDKey := Findwindow('TFrmcontrol','JMEVCD');
if not (HWndVCDKey = 0) then
begin
bringwindowtotop(HwndVCDkey);
keybd_event(VkKeyScan('s'),0,0,0);
keybd_event(VkKeyScan('s'),0,0,keyeventf_keyup);
StatusForm.StatusLabel.Caption:='Stop/Eject';
StatusForm.Show;
end;
end;
//画面放大缩小,不显示提示
if (IntToHex(message.lparam and $80FF0000,8) = '80200000') then
begin
HWndVCDKey := Findwindow('TFrmControl','JMEVCD');
bringwindowtotop(HwndVCDkey);
keybd_event(Vk_space,0,0,0);
keybd_event(Vk_space,0,0,keyeventf_keyup);
// StatusForm.StatusLabel.Caption:='Zoom';
// StatusForm.Show;
end;
//启动浏览器软件
if (IntToHex(message.lparam and $80FF0000,8) = '802E0000') then
begin
Filename:='browser.lnk';
ExecuteFile(Filename,'','c:/progra~1/jmesoft',1);
StatusForm.StatusLabel.Caption:='Browser';
StatusForm.Show;
end;
//启动邮件软件
if (IntToHex(message.lparam and $80FF0000,8) = '80300000') then
begin
Filename:='email.lnk';
ExecuteFile(Filename,'','c:/progra~1/jmesoft',1);
StatusForm.StatusLabel.Caption:='E-mail';
StatusForm.Show;
end;
{//关闭视窗
if (IntToHex(message.lparam and $80FF0000,8) = '80300000') then
begin
keybd_event(VK_MENU, MapVirtualkey(VK_MENU, 0 ), 0, 0);
keybd_event(VK_F4, MapVirtualKey(VK_F4, 0), 0, 0);
keybd_event(VK_F4, MapVirtualKey(VK_F4, 0), KEYEVENTF_KEYUP, 0);
keybd_event(VK_MENU, MapVirtualkey(VK_MENU, 0 ), KEYEVENTF_KEYUP, 0);
// PostMessage(GetWindow(Handle,GW_hwndfirst),WM_CLOSE,0,0);
end;
}
//启动屏幕保护
if (IntToHex(message.lparam and $80FF0000,8) = '806D0000') then
begin
Filename:='screen.lnk';
ExecuteFile(Filename,'','c:/progra~1/jmesoft',1);
end;
//音量键抬起，则关闭音量显示窗口
if (IntToHex(message.lparam and $80FF0000,8) = '80650000') then
begin
MainForm.SoundFormTimer.Enabled:=True;
end;
if (IntToHex(message.lparam and $80FF0000,8) = '80660000') then
begin
MainForm.SoundFormTimer.Enabled:=True;
end;
end;
except
showmessage('There is a error in keyup');
end;
end;

procedure TMainForm.SoundClick(Sender: TObject);
begin
SoundForm.Show;
end;

end.

这部分是dll的主文件，源自钱达智的例子
library Keyhook;
uses
windows, messages,HKProc in 'HKProc.pas';
exports
EnableHotKeyHook,
DisableHotKeyHook;
begin
hNextHookProc := 0;
procSaveExit := ExitProc;
ExitProc := @HotKeyHookExit;
end.

这部分是dll程序，源自钱达智的例子，我在键盘处理部分加了一些代码
unit HKProc;
interface
uses
Windows, Messages,Sysutils,classes;
var
hNextHookProc: HHook;
procSaveExit: Pointer;

function KeyboardHookHandler(iCode: Integer;wParam: WPARAM;
lParam: LPARAM): LRESULT;
stdcall;
export;
function EnableHotKeyHook: BOOL;
export;
function DisableHotKeyHook: BOOL;
export;
procedure HotKeyHookExit;
far;
implementation
function KeyboardHookHandler(iCode: Integer;wParam: WPARAM;
lParam: LPARAM): LRESULT;
stdcall;
export;
const
_KeyPressMask = $80000000;
var
HWndHotKey : HWnd;
begin
Result := 0;
If iCode < 0 then
begin
Result := CallNextHookEx(hNextHookProc, iCode, wParam, lParam);
Exit;
end;
if (IntToHex(wParam,2) = 'FF') then
begin
HWndHotKey:= FindWindow('TMainForm', 'hotkey');
BringWindowToTop(HWnDHotKey);
if ((lparam and _KeyPressMask) = 0 ) then
begin
postmessage(HWnDHotKey,WM_keyDown,wParam,lParam);
Result:= 1;
end
else
begin
postmessage(HWnDHotKey,WM_keyUp,wParam,lParam);
Result:= 1;
end;
end;
end;

function EnableHotKeyHook: BOOL;
export;
begin
Result := False;
if hNextHookProc <> 0 then
Exit;
hNextHookProc := SetWindowsHookEx(WH_KEYBOARD,
KeyboardHookHandler,HInstance,0);
Result := hNextHookProc <> 0;
end;

function DisableHotKeyHook: BOOL;
export;
begin
if hNextHookProc <> 0 then
begin
UnhookWindowshookEx(hNextHookProc);
hNextHookProc := 0;
end;
Result := hNextHookProc = 0;
end;

procedure HotKeyHookExit;
begin
if hNextHookProc <> 0 then
DisableHotKeyHook;
ExitProc := procSaveExit;
end;

end.

接受答案了.