VB模拟扫雷游戏_第1页
VB模拟扫雷游戏_第2页
VB模拟扫雷游戏_第3页
VB模拟扫雷游戏_第4页
VB模拟扫雷游戏_第5页
已阅读5页,还剩25页未读 继续免费阅读

下载本文档

版权说明:本文档由用户提供并上传,收益归属内容提供方,若内容存在侵权,请进行举报或认领

文档简介

VB模拟扫雷游戏的尝试编程目的那天老师展示了一个不完全的扫雷,激发了编程欲望,于是写了扫雷来练练手。编程思路新建command_up和label_down,本来要用text_down,但是后来在左右键同时按下的时候与TextBox的enable冲突,于是改成label。用load加载控件根据雷区的X、Y、以及难度进行随机布雷。统计每一个label周围雷的数量并作为label的caption。在单击command的时候显示label在右击command的时候进行标记在label上左右键同时按下的时候检查已标记雷的数量与label显示的数量是否一致。界面设计代码设计DimStart_Time,End_TimeDimArea_X%,Area_Y%,Area%,Area_List()DimCurrent_Mine%DimDifficulty#DimContinue_Flag%,Success_Flag%,LeftAndRight_Flag%DimNear_ListDimMine_CountPrivateSubCommand_End_Click()EndEndSubPrivateSubDelete_Item(List(),IndexAsInteger)Dimi%Fori=LBound(List)+Index-1ToUBound(List)-1List(i)=List(i+1)Nexti'防止100%的困难度IfUBound(List)>LBound(List)ThenReDimPreserveList(LBound(List)ToUBound(List)-1)EndSubPrivateSubCommand_retry_Click()'卸载Fori=1ToAreaUnloadLabel_Down(i)UnloadCommand_Up(i)NextiCommand_Start.Caption="开始游戏"CallCommand_Start_ClickEndSubPrivateSubCommand_Up_Click(IndexAsInteger)Success_Flag=1IfContinue_Flag=1ThenIfTimer1.Enabled=FalseThenCallCommand_Start_ClickIfLabel_Down(Index).Caption="X"ThenSuccess_Flag=0Continue_Flag=0Fori=1ToAreaIfCommand_Up(i).Visible=TrueAndCommand_Up(i).Caption="X"AndLabel_Down(i).BackColor=vbRedThen'标记雷正确Command_Up(i).Picture=LoadPicture(App.Path+"\pictures\mine_correct.gif",,,Command_Up(i).Width,Command_Up(i).Height)Command_Up(i).Visible=TrueLabel_Down(i).Visible=TrueElseIfCommand_Up(i).Visible=TrueAndCommand_Up(i).Caption="X"AndLabel_Down(i).BackColor=vbGreenThen'标记雷错误Command_Up(i).Picture=LoadPicture(App.Path+"\pictures\mine_wrong.gif",,,Command_Up(i).Width,Command_Up(i).Height)Command_Up(i).Visible=TrueLabel_Down(i).Visible=TrueElseCommand_Up(i).Visible=FalseLabel_Down(i).Visible=TrueEndIfNextiTimer1.Enabled=Falsetemp=MsgBox("GameOver!",vbOKOnly,"游戏结束")ElseIfVal(Label_Down(Index).Caption)>0ThenCommand_Up(Index).Visible=FalseLabel_Down(Index).Visible=TrueElse'如果等于0的话应该将周边的清零Command_Up(Index).Visible=FalseLabel_Down(Index).Visible=Truej=IndexFori=1To8'判断控件是否存在Ifj+Near_List(i)>0Andj+Near_List(i)<=AreaThen'判断是否相邻IfAbs(Label_Down(j+Near_List(i)).Left-Label_Down(j).Left)<=Label_Down(j).WidthAndAbs(Label_Down(j+Near_List(i)).Top-Label_Down(j).Top)<=Label_Down(j).HeightThen'判断是否有雷IfLabel_Down(j+Near_List(i)).BackColor=vbGreenAndCommand_Up(j+Near_List(i)).Visible=TrueThenCallCommand_Up_Click(j+Near_List(i))'注意此处循环调用的时候一定要避免陷入死循环EndIfEndIfEndIfNextiEndIf'检查是否游戏成功Fori=1ToAreaIfCommand_Up(i).Visible=TrueAndLabel_Down(i).Caption<>"X"ThenSuccess_Flag=0ExitForEndIfNextiIfSuccess_Flag=1ThenIfContinue_Flag=1ThenTimer1.Enabled=FalseFori=1ToAreaIfCommand_Up(i).Visible=TrueAndCommand_Up(i).Caption="X"AndLabel_Down(i).BackColor=vbRedThen'标记雷正确Command_Up(i).Picture=LoadPicture(App.Path+"\pictures\mine_correct.gif",,,Command_Up(i).Width,Command_Up(i).Height)Command_Up(i).Visible=TrueLabel_Down(i).Visible=TrueElseIfCommand_Up(i).Visible=TrueAndCommand_Up(i).Caption="X"AndLabel_Down(i).BackColor=vbGreenThen'标记雷错误Command_Up(i).Picture=LoadPicture(App.Path+"\pictures\mine_wrong.gif",,,Command_Up(i).Width,Command_Up(i).Height)Command_Up(i).Visible=TrueLabel_Down(i).Visible=TrueElseCommand_Up(i).Visible=FalseLabel_Down(i).Visible=TrueEndIfNextitemp=MsgBox("恭喜,扫雷成功!"&vbCrLf&"耗时:"&Mid(Label_Time.Caption,4)&vbCrLf&"鸣谢:平方XO(∩_∩)O~",vbOKOnly,"成功")EndIfContinue_Flag=0'提示一次后结束,防止在调用Command_Click事件中重复提示EndIfEndIfCommand_Start.SetFocusEndSubPrivateSubCommand_Start_Click()IfCommand_Start.Caption="开始游戏"ThenCommand_Start.Caption="重新开始"Continue_Flag=1Timer1.Enabled=TrueDifficulty=Val(Text_Difficulty.Text)/100Area_X=Val(Text_X.Text)Area_Y=Val(Text_Y.Text)Area=Area_X*Area_Y'初始化这里进行二次初始化的原因是如果在之前的运行中对字体进行了改变,将有可能造成此处的控件大小发生变化WithPicture_show.Left=200.Top=200.Width=750*10.Height=750*10.Visible=FalseEndWithWithCommand_Up(0).Left=Picture_show.Left.Top=Picture_show.Top.Width=Picture_show.Width/10.Height=Picture_show.Height/10.FontSize=1'防止自动缩放.Visible=FalseEndWithWithLabel_Down(0).Left=Picture_show.Left.Top=Picture_show.Top.Width=Picture_show.Width/10.Height=Picture_show.Height/10.FontSize=1'防止自动缩放.Visible=FalseEndWithWithLabel_Down(0).Left=200.Top=200.Width=750*10/IIf(Area_X>Area_Y,Area_X,Area_Y).FontSize=25*(.Width/750)'会自动缩放,必须先设置了.Height=750*10/IIf(Area_X>Area_Y,Area_X,Area_Y).Visible=FalseEndWithWithCommand_Up(0).Left=200.Top=200.Width=Label_Down(0).Width.Height=Label_Down(0).Height.Visible=FalseEndWithReDimNear_List(1To8)Near_List(1)=0-1-Area_YNear_List(2)=0-0-Area_YNear_List(3)=0+1-Area_YNear_List(4)=0-1Near_List(5)=0+1Near_List(6)=0-1+Area_YNear_List(7)=0-0+Area_YNear_List(8)=0+1+Area_Y'如果在列表中有相等的元素将有可能造成统计雷的数目错误Fori=1To8Forj=i+1To8IfNear_List(i)=Near_List(j)ThenNear_List(i)=0NextjNextiArea_temp=0ForY=1ToArea_Y'加载labelForX=1ToArea_XArea_temp=Area_temp+1LoadLabel_Down(Area_temp)WithLabel_Down(Area_temp).Left=Label_Down(0).Left+Label_Down(0).Width*((Area_temp-1)ModArea_Y).Top=Label_Down(0).Top+Label_Down(0).Height*((Area_temp-1)\Area_Y).BackColor=vbGreen.Visible=False.Alignment=2.Font=.FontBoldEndWith'加载commandLoadCommand_Up(Area_temp)WithCommand_Up(Area_temp)'对列数求余的话就是在这一行第几个了.Left=Command_Up(0).Left+Command_Up(0).Width*((Area_temp-1)ModArea_Y)'整除列数的话可以确定第几行.Top=Command_Up(0).Top+Command_Up(0).Height*((Area_temp-1)\Area_Y).Visible=TrueEndWithNextXNextYReDimArea_List(1ToArea)Fori=1ToAreaArea_List(i)=iNexti'随即布雷RandomizeMine_Count=Val(Text_Mine_Count.Text)Fori=1ToMine_CountCurrent_Mine=Int(Rnd*(UBound(Area_List)-LBound(Area_List)+1)+1)'在数组中随机一个,注意此处2个+1的必要性和准确性Label_Down(Area_List(Current_Mine)).BackColor=vbRed'将该位置标记为雷CallDelete_Item(Area_List,Current_Mine)'删除该位置,防止再次标记Nexti'检查雷的数目Forj=1ToAreaIfLabel_Down(j).BackColor=vbRedThenLabel_Down(j).Caption="X"ElseMine_Number=0Fori=1To8'判断控件是否存在Ifj+Near_List(i)>0Andj+Near_List(i)<=AreaThen'判断是否相邻IfAbs(Label_Down(j+Near_List(i)).Left-Label_Down(j).Left)<=Label_Down(j).WidthAndAbs(Label_Down(j+Near_List(i)).Top-Label_Down(j).Top)<=Label_Down(j).HeightThen'判断是否有雷IfLabel_Down(j+Near_List(i)).BackColor=vbRedThenMine_Number=Mine_Number+1EndIfEndIfEndIfNextiLabel_Down(j).Caption=Mine_NumberEndIfNextjStart_Time=Now()ElseIfCommand_Start.Caption="重新开始"ThenCallCommand_retry_ClickEndIfEndSubPrivateSubCommand_Up_MouseDown(IndexAsInteger,ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)IfButton=2ThenIfCommand_Up(Index).Caption=""ThenCommand_Up(Index).Caption="X"Command_Up(Index).Picture=LoadPicture(App.Path+"\pictures\mine.gif",,,Command_Up(Index).Width,Command_Up(Index).Height)ElseIfCommand_Up(Index).Caption="X"ThenCommand_Up(Index).Caption="?"Command_Up(Index).Picture=LoadPicture(App.Path+"\pictures\Unknown.gif",,,Command_Up(Index).Width,Command_Up(Index).Height)ElseIfCommand_Up(Index).Caption="?"ThenCommand_Up(Index).Caption=""Command_Up(Index).Picture=LoadPicture("")EndIfEndIfEndSubPrivateSubForm_Load()WithPicture_show.Left=200.Top=200.Width=750*10.Height=750*10.Visible=FalseEndWithWithCommand_Up(0).Left=Picture_show.Left.Top=Picture_show.Top.Width=Picture_show.Width/10.Height=Picture_show.Height/10.FontSize=1'防止自动缩放.Visible=FalseEndWithWithLabel_Down(0).Left=Picture_show.Left.Top=Picture_show.Top.Width=Picture_show.Width/10.Height=Picture_show.Height/10.FontSize=1'防止自动缩放.Visible=FalseEndWith'加载计时器Timer1.Enabled=FalseTimer1.Interval=100'加载滚动条WithHScroll_Difficulty.LargeChange=5.SmallChange=1.Max=100.Min=0.Value=10EndWithWithHScroll_Area_X.LargeChange=5.SmallChange=1.Max=100.Min=1.Value=10EndWithWithHScroll_Area_Y.LargeChange=5.SmallChange=1.Max=100.Min=1.Value=10EndWithWithHScroll_Mine_Count.LargeChange=5.SmallChange=1.Max=100.Min=0.Value=10EndWith'由于很多数据不方便处理,索性让其禁用了Text_Difficulty.Enabled=FalseText_Mine_Count.Enabled=FalseText_X.Enabled=FalseText_Y.Enabled=FalseEndSubPrivateSubHScroll_Area_X_Change()Text_X.Text=HScroll_Area_X.ValueHScroll_Mine_Count.Max=HScroll_Area_X.Value*HScroll_Area_Y.ValueHScroll_Mine_Count.Value=HScroll_Area_X.Value*HScroll_Area_Y.Value/100*HScroll_Difficulty.ValueEndSubPrivateSubHScroll_Area_X_Scroll()Text_X.Text=HScroll_Area_X.ValueHScroll_Mine_Count.Max=HScroll_Area_X.Value*HScroll_Area_Y.ValueHScroll_Mine_Count.Value=HScroll_Area_X.Value*HScroll_Area_Y.Value/100*HScroll_Difficulty.ValueEndSubPrivateSubHScroll_Area_Y_Change()Text_Y.Text=HScroll_Area_Y.ValueHScroll_Mine_Count.Max=HScroll_Area_X.Value*HScroll_Area_Y.ValueHScroll_Mine_Count.Value=HScroll_Area_X.Value*HScroll_Area_Y.Value/100*HScroll_Difficulty.ValueEndSubPrivateSubHScroll_Area_Y_Scroll()Text_Y.Text=HScroll_Area_Y.ValueHScroll_Mine_Count.Max=HScroll_Area_X.Value*HScroll_Area_Y.ValueHScroll_Mine_Count.Value=HScroll_Area_X.Value*HScroll_Area_Y.Value/100*HScroll_Difficulty.ValueEndSubPrivateSubHScroll_Difficulty_Change()Text_Difficulty.Text=HScroll_Difficulty.ValueHScroll_Mine_Count.Value=HScroll_Area_X.Value*HScroll_Area_Y.Value/100*HScroll_Difficulty.ValueEndSubPrivateSubHScroll_Difficulty_Scroll()Text_Difficulty.Text=HScroll_Difficulty.ValueHScroll_Mine_Count.Value=HScroll_Area_X.Value*HScroll_Area_Y.Value/100*HScroll_Difficulty.ValueEndSubPrivateSubHScroll_Mine_Count_Change()Text_Mine_Count.Text=HScroll_Mine_Count.ValueHScroll_Difficulty.Value=HScroll_Mine_Count.Value/(HScroll_Area_X.Value*HScroll_Area_Y.Value)*100EndSubPrivateSubHScroll_Mine_Count_Scroll()Text_Mine_Count.Text=HScroll_Mine_Count.ValueHScroll_Difficulty.Value=HScroll_Mine_Count.Value/(HScroll_Area_X.Value*HScroll_Area_Y.Value)*100EndSubPrivateSubLabel_Down_MouseUp(IndexAsInteger,ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)Fori=1To8'判断控件是否存在IfIndex+Near_List(i)>0AndIndex+Near_List(i)<=AreaThen'判断是否相邻IfAbs(Label_Down(Index+Near_List(i)).Left-Label_Down(Index).Left)<=Label_Down(Index).WidthAndAbs(Label_Down(Index+Near_List(i)).Top-Label_Down(Index).Top)<=Label_Down(Index).HeightThen'判断是否有标记雷IfCommand_Up(Index+Near_List(i)).Caption<>"X"AndCommand_Up(Index+Near_List(i)).Caption<>"?"ThenCommand_Up(Index+Near_List(i)).Picture=LoadPicture("")EndIfEndIfEndIfNextiEndSubPrivateSublabel_down_MouseDown(IndexAsInteger,ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)IfLeftAndRight_Flag+Button=3Then'双击完成Mine_Number=Val(Label_Down(Index).Caption)Mark_mine_number=0Fori=1To8'判断控件是否存在IfIndex+Near_List(i)>0AndIndex+Near_List(i)<=AreaThen'判断是否相邻IfAbs(Label_Down(Index+Near_List(i)).Left-Label_Down(Index).Left)<=Label_Down(Index).WidthAndAbs(Label_Down(Index+Near_List(i)).Top-Label_Down(Index).Top)<=Label_Down(Index).HeightThen'判断是否有标记雷IfCommand_Up(Index+Near_List(i)).Caption="X"ThenMark_mine_number=Mark_mine_number+1EndIfEndIfEndIfNextiIfVal(Label_Down(Index).Caption)-Mark_mine_number<=0Then'已全部标出,自动点开Fori=1To8'判断控件是否存在IfIndex+Near_List(i)>0AndIndex+Near_List(i)<=AreaThen'判断是否相邻IfAbs(Label_Down(Index+Near_List(i)).Left-Label_Down(Index).Left)<=Label_Down(Index).WidthAndAbs(Label_Down(Index+Near_List(i)).Top-Label_Down(Index).Top)<=Label_Down(Index).HeightThen'判断是否有标记雷IfCommand_Up(Index+Near_List(i)).Caption<>"X"ThenCallCommand_Up_Click(Index+Near_List(i))EndIfEndIfEndIfNextiElse'如果没有全部标注的话应该显示一下嘛Fori=1To8'判断控件是否存在IfIndex+Near_List(i)>0AndIndex+Near_List(i)<=AreaThen'判断是否相邻IfAbs(Label_Down(Index+Near_List(i)).Left-Label_Down(Index).Left)<=Label_Down(Index).WidthAndAbs(Label_Down(Index+Near_List(i)).Top-Label_Down(Index).Top)<=Label_Down(Index).HeightThen'判断是否有标记雷IfCommand_Up(Index+Near_List(i)).Caption<>"X"ThenCommand_Up(Index+Near_List(i)).Picture=LoadPicture(App.Path+"\pictures\xia.gif",,,Command_Up(Index).Width,Command_Up(Index).Height)EndIfEndIfEndIfNextiEndIfElseLeftAndRight_Flag=Button'PrintLeftAndRight_FlagEndIfEndSubPrivateSubTimer1_Timer()LeftAndRight_Flag=0End_Time=Now()spend_time=(End_Time-Start_Time)*10^5Label_Time.Caption="时间:"&Format(Int(spend_time)\(60*60),"00")&":"&Format((Int(spend_time)Mod(60*60))\60,"00")&":"&Format(Int(spend_time)Mod60,"00")&"."&Format(Int((spend_time-Int(spend_time))*1000),"000")EndSub软件截图123附录资料:不需要的可以自行删除VBHOOK(钩子)超级无敌详细用法(介绍)hook是WINDOWS提供的一种消息处理机制,它使得程序员可以使用子过程来监视系统消息,并在消息到达目标过程前得到处理。

下面将介绍WINNDOWSHOOKS并且说明如何在WINDOWS程序中使用它。关于HOOKS

使用HOOK将会降低系统效率,因为它增加了系统处量消息的工作量。建议在必要时才使用HOOK,并在消息处理完成后立即移去该HOOK。

HOOK链

WINDOWS提供了几种不同类型的HOOKS;不同的HOOK可以处理不同的消息。例如,WH_MOUSEHOOK用来监视鼠标消息。

WINDOWS为这几种HOOKS维护着各自的HOOK链。HOOK链是一个由应用程序定义的回调函数队列,当某种类型的消息发生时,WINDOWS向此种类型的HOOK链的第一个函数发送该消息,在第一函数处理完该消息后由该函数向链表中的下一个函数传递消息,依次向下。如果链中某个函数没有向下传送该消息,那么链表中后面的函数将得不到此消息。(对于某些类型的HOOK,不管HOOK链中的函数是否向下传递消息,与此类型HOOK联系的所有HOOK函数都会收到系统发送的消息)

HOOK过程

为了拦截特定的消息,你可以使用SetWindowsHookEx函数在该类型的HOOK链中安装你自己的HOOK函数。该函数语法如下:

publicfunctionMyHook(nCode,wParam,iParam)aslong

‘加入代码

endfunction

其中MyHook可以随便命名,其它不能变。该函数必须放在模块段。nCode指定HOOK类型。wParam,iParam的取值随nCode不同而不同,它代表了某种类型的HOOK的某个特定的动作。

SetWindowsHookEx总是将你的HOOK函数放置在HOOK链的顶端。你可以使用CallNextHookEx函数将系统消息传递给HOOK链中的下一个函数。

[注释]对于某些类型的HOOK,系统将向该类的所有HOOK函数发送消息,这时,HOOK函数中的CallNextHookEx语句将被忽略。

全局HOOK函数可以拦截系统中所有线程的某个特定的消息(此时该HOOK函数必须放置在DLL中),局部HOOK函数可以拦截指定线程的某特定消息(此时该HOOK函数可以放置在DLL中,也可以放置在应用程序的模块段)。

[注释]建议只在调试时使用全局HOOK函数。全局HOOK函数将降低系统效率,并且会同其它使用该类HOOK的应用程序产生冲突。

HOOK类型

WH_CALLWNDPROC和WH_CALLWNDPROCRETHOOK

WH_CALLWNDPROC和WH_CALLWNDPROCRETHOOK可以监视SendMessage发送的消息。系统在向窗体过程发送消息前,将调用WH_CALLWNDPROC;在窗体过程处理完该消息后系统将调用WH_CALLWNDPROCRET。

WH_CALLWNDPROCRETHOOK会向HOOK过程传送一个CWPRETSTRUCT结构的地址。该结构包含了窗体过程处理系统消息后的一些信息。

WH_CBTHook

系统在激活,创建,消毁,最小化,最大化,移动,改变窗体前;在完成一条系统命令前;在从系统消息队列中移去鼠标或键盘事件前;在设置输入焦点前,或同步系统消息队列前,将调用WH_CBTHOOK。你可以在你的HOOK过程拦截该类HOOK,并返回一个值,告诉系统,是否继续执行上面的操作。

WH_DEBUGHOOK

系统在调用与某种HOOK类型联系的HOOK过程前,将调用WH_DEBUG,应用程序可以使用该HOOK决定是否让系统执行某种类型的HOOK。

WH_FOREGROUNDIDLEHook

系统在空闲时调用该HOOK,在后台执行优先权较低的应用程序。

WH_GETMESSAGEHook

WH_GETMESSAGEHook使应用程序可以拦截GetMessage或PeekMessage的消息。应用程序使用WH_GETMESSAGEHOOK监视鼠标、键盘输入和发送到队列中的其它消息。

WH_JOURNALRECORDHook

WH_JOURNALRECORDHook使应用程序可以监视输入事件。典型地,应用程序使用该HOOK记录鼠标、键盘输入事件以供以后回放。该HOOK是全局HOOK,并且不能在指定线程中使用。

WH_JOURNALPLAYBACKHook

`WH_JOURNALPLAYBACKHook使应用程序可以向系统消息队列中插入消息。该HOOK可以回放以前由WH_JOURNALRECORDHOOK录制的鼠标、键盘输入事件。在WH_JOURNALPLAYBACKHook安装到系统时,鼠标、键盘输入事件将被屏蔽。该HOOK同样是一个全局HOOK,不能在指定线程中使用。

WH_JOURNALPLAYBACKHook返回一个时间暂停值,它告诉系统,在处理当前回放的消息时,系统等待百分之几秒。这使得此HOOK可以控制在回放时的时间事件。

WH_KEYBOARDHook

WH_KEYBOARDHook使应用程序可以监视由GetMessage和PeekMessage返回的WM_KEYDOWN及WM_KEYUP消息。应用程序使用该HOOK监视发送到消息队列中的键盘输入。

WH_MOUSEHook

WH_MOUSEHook使应用程序可以监视由GetMessage和PeekMessage返回的消息。应用程序使用该HOOK监视发送到消息队列中的鼠标输入。

WH_MSGFILTERandWH_SYSMSGFILTERHooks

WH_MSGFILTER和WH_SYSMSGFILTERHooks使应用程序可以监视菜单、滚动条、消息框、对话框,当用户使用ALT+TAB或ALT+ESC来切换窗体时,该HOOK也可以拦截到消息。WH_MSGFILTER仅在应用程序内部监视菜单、滚动条、消息框、对话框,而WH_SYSMSGFILTER则可以在系统内监视所有应用程序的这些事件。

WH_SHELLHook

一个SHELL程序可以使用WH_SHELLHook来接收重要的信息。当一个SHELL程序被激活前或当前窗体被创建、消毁时,系统会调用WH_SHELLHook过程。

使用HOOK

安装、销毁HOOK过程

监视系统事件安装、销毁HOOK过程

使用SetWindowsHookEx函数,指定一个HOOK类型,自己的HOOK过程是全局还是局部HOOK,同时给出HOOK过程的进入点,就可以轻松的安装你自己的HOOK过程。DeclareFunctionSetWindowsHookExLib"user32"Alias"SetWindowsHookExA"_

(ByValidHookAsLong,_

ByVallpfnAsLong,

_

ByValhmodAsLong,

_

ByValdwThreadIdAsLong)AsLongidHook代表是何种Hook,有以下几种

PublicConstWH_CALLWNDPROC=4

PublicConstWH_CALLWNDPROCRET=12

PublicConstWH_CBT=5

PublicConstWH_DEBUG=9

PublicConstWH_FOREGROUNDIDLE=11

PublicConstWH_GETMESSAGE=3

PublicConstWH_HARDWARE=8

PublicConstWH_JOURNALPLAYBACK=1

PublicConstWH_JOURNALRECORD=0

PublicConstWH_KEYBOARD=2

PublicConstWH_MOUSE=7

PublicConstWH_MSGFILTER=(-1)

PublicConstWH_SHELL=10

PublicConstWH_SYSMSGFILTER=6lpfn代表HookFunction所在的Address,这是一个CallBackFucnction,当挂上某个Hook时,我们便得定义一个Function来当作某个讯息产生时,来处理它的Function,这个HookFunction有一定的叁数格式

PrivateFunctionHookFunc(ByValnCodeAsLong,_

ByValwParamAsLong,_

ByVallParamAsLong)AsLong

nCode代表是什麽请况之下所产生的Hook,随Hook的不同而有不同组的可能值。

wParamlParam传回值则随Hook的种类和nCode的值之不同而不同。

因这个叁数是一个Function的Address所以我们固定将HookFunction放在.Bas中,并以AddressOfHookFunc传入。至於HookFunction的名称我们可以任意给定,不一定叫HookFunchmod代表.DLL的hInstance,如果是LocalHook,该值可以是Null(VB中可传0进去),而如果是RemoteHook,则可以使用GetModuleHandle(".dll名称")来传入。dwThreadId代表执行这个Hook的ThreadId,如果不设定是那个Thread来做,则传0(所以一般来说,RemoteHook传0进去),而VB的LocalHook一般可传App.ThreadId进去。值回值如果SetWindowsHookEx()成功,它会传回一个值,代表目前的Hook的Handle,这个值要记录下来。因为A程式可以有一个SystemHook(RemoteHook),如KeyBoardHook,而B程式也来设一个Remote的KeyBoardHook,那麽到底KeyBoard的讯息谁所拦截?答案是,最後的那一个所拦截,也就是说A先做keyboardHook,而後B才做,那讯息被B拦截,那A呢?就看B的HookFunction如何做。如果B想让A的HookFunction也得这个讯息,那B就得呼叫CallNextHookEx()将这讯息Pass给A,於是产生Hook的一个连线。如果B中不想Pass这讯息给A,那就不要呼叫CallNextHookEx()。DeclareFunctionCallNextHookExLib"user32"Alias"CallNextHookEx"_

(ByValhHookAsLong,_

ByValncodeAsLong,_

ByValwParamAsLong,_

lParamAsAny)AsLonghHook值是SetWindowsHookEx()的传回值,nCode,wParam,lParam则是HookProcedure中的三个叁数。最後是将这Hook去除掉,请呼叫UnHookWindowHookEx()DeclareFunctionUnhookWindowsHookExLib"user32"Alias"UnhookWindowsHookEx"

_

(ByValhHookAsLong)AsLonghHook便是SetWindowsHookEx()的传回值。此时,以上例来说,B程式结束Hook,则换A可以直接拦截讯息。

KeyBoardHook的范例HookFunction的三个叁数nCode

wParam

lParam

传回值

HC_ACTION

表按键VirtualKey

与WM_KEYDOWN同若讯息要被处理传0

反之传1

HC_NOREMOVE

PublichHookasLongPublicSubUnHookKBD()

Ifhnexthookproc<>0Then

UnhookWindowsHookExhHook

hHook=0

EndIf

EndSubPublicFunctionEnableKBDHook()

IfhHook<>0Then

ExitFunction

EndIf

hhook=SetWindowsHookEx(WH_KEYBOARD,AddressOf_

MyKBHFunc,App.hInstance,App.ThreadId)

EndFunctionPublicFunctionMyKBHFunc(ByValiCodeAsLong,_

ByValwParamAsLong,ByVallParamAsLong)AsLong

MyKBHfunc=0'表示要处理这个讯息

IfwParam=vbKeySnapshotThen

'侦测有没有按到PrintScreen键

MyKBHFunc=1'在这个Hook便吃掉这个讯息

EndIf

CallCallNextHookEx(hHook,iCode,wParam,lParam)'传给下一个Hook

EndFunction鼠标钩子的示例列下。(1)模块中输入:PublicConstWM_MOUSEMOVE=&H200

PublicConstWM_LBUTTONDOWN=&H201

PublicConstWM_LBUTTONUP=&H202

PublicConstWM_LBUTTONDBLCLK=&H203

PublicConstWM_RBUTTONDOWN=&H204

PublicConstWM_RBUTTONUP=&H205

PublicConstWM_RBUTTONDBLCLK=&H206

PublicConstWM_MBUTTONDOWN=&H207

PublicConstWM_MBUTTONUP=&H208

PublicConstWM_MBUTTONDBLCLK=&H209

PublicConstWM_MOUSEACTIVATE=&H21

PublicConstWM_MOUSEFIRST=&H200

PublicConstWM_MOUSELAST=&H209

PublicConstWM_MOUSEWHEEL=&H20A

'以上是鼠标的各个值

PrivateDeclareFunctionCallNextHookExLib"user32"(ByValhHookAsLong,ByValnCodeAsLong,ByValwParamAsLong,lparamAsAny)AsLongPublicFunctionHookProc(ByValnCodeAsLong,ByValwParamAsLong,ByVallparamAsLong)AsLong

IfnCode<0Then

温馨提示

  • 1. 本站所有资源如无特殊说明,都需要本地电脑安装OFFICE2007和PDF阅读器。图纸软件为CAD,CAXA,PROE,UG,SolidWorks等.压缩文件请下载最新的WinRAR软件解压。
  • 2. 本站的文档不包含任何第三方提供的附件图纸等,如果需要附件,请联系上传者。文件的所有权益归上传用户所有。
  • 3. 本站RAR压缩包中若带图纸,网页内容里面会有图纸预览,若没有图纸预览就没有图纸。
  • 4. 未经权益所有人同意不得将文件中的内容挪作商业或盈利用途。
  • 5. 人人文库网仅提供信息存储空间,仅对用户上传内容的表现方式做保护处理,对用户上传分享的文档内容本身不做任何修改或编辑,并不能对任何下载内容负责。
  • 6. 下载文件中如有侵权或不适当内容,请与我们联系,我们立即纠正。
  • 7. 本站不保证下载资源的准确性、安全性和完整性, 同时也不承担用户因使用这些下载资源对自己和他人造成任何形式的伤害或损失。

评论

0/150

提交评论