应用程序初始化失败

zhangzii 2007-05-18 08:32:37
本人照书上的例子作一个鼠标钩子,可是一点击运行,出现“应用程序正常初始化失败”,百思不得其解啊,搜索俩论坛也没有相关内容,请大家帮忙看下,源代码如下
library hook;

{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }

uses
SysUtils,
Classes,
windows,
Messages,
Unit11 in 'Unit11.pas';


begin
end.
//////////钩子的dll
unit Unit11;

interface
uses
SysUtils,
Classes,
windows;
type
TShareData=packed record
data1:array [1..2] of DWORD;
data2:TMOUSEHOOKSTRUCT;
buffer:array[0..1024]of char;
end;
const VirtualFileName='ShareDllData';
DataSize=sizeof(TShareData);
var
hMapFile:THandle;
InstalledHook:HHook;
shareData:^TShareData;
implementation


function HookHandler(iCode:Integer;wParam:WPARAM;lParam:LPARAM):LRESULT;
begin
ShareData^.data2:=pMOUSEHOOKSTRUCT(lParam)^;
SendMessage(ShareData.data1[1],shareData.data1[2],wParam,0);
Result:=CallNextHookEx(InstalledHook,iCode,wParam,lParam);
end;

function OpenGetKeyHook(Sender:HWND;MessageID:WORD):BOOL;stdcall;export;
begin
Result:=false;
if InstalledHook=0 then
begin
ShareData^.data1[1]:=Sender;
ShareData^.data1[2]:=MessageID;
InstalledHook:=SetWindowsHookEx(WH_MOUSE,
@HookHandler,
HInstance,0);
Result:=InstalledHook<>0;
end;
end;
function CloseGetKeyHook:bool;stdcall;export;
begin
if InstalledHook<>0 then
Begin
UnhookWindowsHookEx(InstalledHook);
InstalledHook:=0;
end;
Result:=Installedhook=0;
end;
function GetX:Integer;stdcall;export;
begin
Result:=ShareData^.Data2.pt.X;
end;
function GetY:Integer;stdcall;export;
begin
Result:=ShareData^.Data2.pt.Y;
end;
initialization
InstalledHook:=0;
hMapFile:=CreateFileMapping($FFFFFFFF,nil,Page_ReadWrite,0,DataSize,VirtualFileName);
if hMapFile=0 then
Raise Exception.Create('创建公用数据的buff不成功!');
ShareData:=MapViewofFile(hMapFile,File_Map_Write,0,0,DataSize);
finalization
UnMapViewofFile(ShareData);
CloseHandle(hMapFile);
end.
//////////主调窗口
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
const MessageID=WM_USER+100;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
CheckBox1: TCheckBox;
Button1: TButton;
Button2: TButton;
procedure CheckBox1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
procedure GetMsg(var Message:TMessage);message MessageID;
{ Private declarations }
public
{ Public declarations }
end;
function OpenGetKeyHook(Sender:HWND;MeeageID:WORD):bool;external 'hook.dll';
function CloseGetKeyHook():bool;external 'hook.dll';
function GetX:Integer;external 'hook.dll';
function GetY:Integer;external 'hook.dll';
var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if checkbox1.Checked=true then
form1.FormStyle:=fsStayOnTop
else
form1.FormStyle:=fsnormal;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
checkbox1.Checked:=true;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenGetKeyHook(Form1.handle,MessageId)=false then
MessageDlg('安装钩子失败!',mtError,[mbOK],0);
end;

procedure TForm1.GetMsg(var Message: TMessage);
begin
if message.Msg=MessageID then
begin
Edit1.Text:=InttoStr(GetX);
Edit2.Text:=InttoStr(GetY);
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if CloseGetKeyHook=false then
MessageDlg('卸载钩子失败!',mtERROR,[mbok],0);
end;

end.
...全文
1062 回复 打赏 收藏 转发到动态 举报
写回复
用AI写文章
回复
切换为时间正序
请发表友善的回复…
发表回复

16,749

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 语言基础/算法/系统设计
社区管理员
  • 语言基础/算法/系统设计社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧