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

提交評論