VB學生信息管理系統(tǒng)及源代碼

VB學生信息管理系統(tǒng)及源代碼OptionExplicit'標識是否能關閉DimmbCloseAsBoolean'標識當前要顯示的照片的文件DimmstrFileNameAsStringPrivateSubForm_Load()OnErrorResumeNextIffrmMain.mnUserType=1Then'學生用戶fraSeek.Enabled=FalsefraBrowse.Enabled=FalsecmdAdd.Enabled=FalsecmdDelete.Enabled=FalsetxtSerial.Enabled=FalsedcbClass.Enabled=FalsegrdScan.Enabled=FalseIfNot(DataEnv.rsStudent.EOFAndDataEnv.rsStudent.BOF)ThenDimTempAsStringTemp="name="&"'"&frmMain.msUserName&"'"DataEnv.rsStudent.MoveFirstDataEnv.rsStudent.FindTemp'刷新所綁定的控件CallRefreshBindingEndIfExitSubElsefraSeek.Enabled=TruefraBrowse.Enabled=TruecmdAdd.Enabled=TruecmdDelete.Enabled=TruetxtSerial.Enabled=TruedcbClass.Enabled=TruegrdScan.Enabled=TrueEndIfDimrsDepAsNewADODB.Recordset,rsClassAsNewADODB.RecordsetSetrsDep=DataEnv.rsDepartmentSetrsClass=DataEnv.rsClassrsDep.Open'從Department表中讀取數(shù)據(jù)，填充cboDep組合框到中cboDep.ClearcboDep.AddItem"全部"'將各個系的id號作為ItemData附加到組合框中cboDep.ItemData(0)=0WhileNotrsDep.EOFcboDep.AddItemrsDep("Name")cboDep.ItemData(cboDep.ListCount-1)=rsDep("id")rsDep.MoveNextWendcboDep.ListIndex=0''從class表中讀取數(shù)據(jù)，填充到cboClass組合框中cboClass.ClearcboClass.AddItem"全部"WhileNotrsClass.EOFcboClass.AddItemrsClass("Name")rsClass.MoveNextWendcboClass.ListIndex=0cmdList.Value=TruefraManage.Enabled=TruembClose=True'調(diào)用grdScan_Change事件顯示記錄明細CallgrdScan_ChangeEndSub'當DataEnv.rsStudent的當前記錄發(fā)生變化時，刷新所綁定的控件(用戶改變了當前記錄)SubRefreshBinding()OnErrorResumeNextWithDataEnv.rsStudentIfDataEnv.rssqlSeek.BOFAndDataEnv.rssqlSeek.EOFThen'如果不存在任何記錄，則清空所有的綁定的內(nèi)容txtSerial=""txtName=""dtpBirth.Value=""txtTelephone=""txtAddress=""txtResume=""imgPhoto.Picture=LoadPicture(Null)Else'否則和相應的字段進行綁定txtSerial=.Fields("serial")txtName=.Fields("name")dtpBirth.Value=.Fields("birthday")txtTelephone=.Fields("tel")txtAddress=.Fields("address")txtResume=.Fields("resume")cboSex.Text=.Fields("sex")dcbClass.Text=.Fields("class")imgPhoto.Picture=LoadPicture(ReadImage(.Fields("photo")))EndIfEndWithEndSub''在DataEnv.rsStudent中查詢serial為sSerial的學籍信息SubSeekStudent(sSerialAsString)IfNot(DataEnv.rsStudent.EOFAndDataEnv.rsStudent.BOF)ThenDimTempAsStringTemp="serial="&"'"&sSerial&"'"DataEnv.rsStudent.MoveFirstDataEnv.rsStudent.FindTemp'刷新所綁定的控件CallRefreshBindingEndIfEndSub''當改變記錄集時，需要刷新用戶導航的網(wǎng)格控件SubRefreshGrid()grdScan.DataMember=""grdScan.RefreshDataEnv.rssqlSeek.RequerygrdScan.DataMember="sqlSeek"grdScan.Refresh'刷新各個綁定控件CallgrdScan_ChangeEndSub''用以在瀏覽時，根據(jù)當前記錄所出的位置不同，來改變各個瀏覽按鈕的狀態(tài)SubChangeBrowseState()WithDataEnv.rssqlSeekIf.State=adStateClosedThen.Open'如果沒有任何記錄，使某些按鈕無效；否則則使這些按鈕有效If.BOFAnd.EOFThencmdAdd.Enabled=TruecmdEdit.Enabled=FalsecmdDelete.Enabled=FalsecmdUpdate.Enabled=FalsecmdReport.Enabled=FalsefraBrowse.Enabled=FalseElsecmdAdd.Enabled=TruecmdEdit.Enabled=TruecmdDelete.Enabled=TruecmdUpdate.Enabled=FalsecmdReport.Enabled=TruefraBrowse.Enabled=TrueEndIf''假如處于記錄的頭部If.BOFThenIfNot.EOFThenDataEnv.rsStudent.MoveFirstcmdPrevious.Enabled=FalsecmdFirst.Enabled=FalseElsecmdPrevious.Enabled=TruecmdFirst.Enabled=TrueEndIf''假如處于記錄的尾部If.EOFThenIfNot.BOFThenDataEnv.rsStudent.MoveLastcmdNext.Enabled=FalsecmdLast.Enabled=FalseElsecmdNext.Enabled=TruecmdLast.Enabled=TrueEndIfEndWithmstrFileName=""EndSubPrivateSubcboDep_Click()DimrsClassAsNewADODB.RecordsetDimstrSQL'根據(jù)所選的系的不同，采用不同的SQL語句IfcboDep.ItemData(cboDep.ListIndex)=0ThenstrSQL="select*from班級信息表"ElsestrSQL="select*from班級信息表wheredept_id="&cboDep.ItemData(cboDep.ListIndex)EndIfrsClass.OpenstrSQL,DataEnv.Con'將所查到的rsClass中的內(nèi)容來填充cboClasscboClass.ClearcboClass.AddItem"全部"WhileNotrsClass.EOFcboClass.AddItemrsClass("Name")rsClass.MoveNextWendcboClass.ListIndex=0rsClass.CloseSetrsClass=NothingEndSubPrivateSubcmdAdd_Click()'添加記錄fraSeek.Enabled=FalsefraBrowse.Enabled=FalsegrdScan.Enabled=FalseDataEnv.rsStudent.AddNewdtpBirth.Value="1980-01-01"fraInfo.Enabled=TruefraBrowse.Enabled=FalsecmdAdd.Enabled=FalsecmdEdit.Enabled=FalsecmdDelete.Enabled=FalsecmdUpdate.Enabled=TruecmdReport.Caption="取消"cmdReport.Enabled=TruembClose=False'不能關閉窗口EndSubPrivateSubcmdDelete_Click()'如果出錯，則顯示錯誤代碼OnErrorGoToerrHandlerIfMsgBox("要刪除記錄?",vbYesNo+vbQuestion+vbDefaultButton2,"確認")=vbYesThen'通過在DataEnv.Con中執(zhí)行SQL命令，來刪除記錄DataEnv.Con.Execute"deletefrom學生信息表whereserial='"&txtSerial&"'"DataEnv.rsStudent.MoveNextIfDataEnv.rsStudent.EOFThenDataEnv.rsStudent.MoveLast'刷新用戶導航的網(wǎng)格控件CallRefreshGridEndIfExitSuberrHandler:MsgBoxErr.Description,vbCritical,"錯誤"EndSubPrivateSubcmdEdit_Click()'編輯記錄之前，需要設置其他控件的Enabled屬性fraSeek.Enabled=FalsefraBrowse.Enabled=FalsegrdScan.Enabled=FalsefraInfo.Enabled=TruecmdAdd.Enabled=FalsecmdEdit.Enabled=FalsecmdDelete.Enabled=FalsecmdUpdate.Enabled=TruecmdReport.Caption="取消"''更改cmdReport標題cmdReport.Enabled=TruembClose=False'出于編輯狀態(tài)，則用戶不能關閉窗口EndSubPrivateSubcmdFirst_Click()'移動到記錄的頭部，并改變各個瀏覽按鈕的狀態(tài)DataEnv.rssqlSeek.MoveFirstDataEnv.rssqlSeek.MovePreviousCallChangeBrowseStateEndSubPrivateSubcmdLast_Click()'移動到記錄的尾部，并改變各個瀏覽按鈕的狀態(tài)DataEnv.rssqlSeek.MoveLastDataEnv.rssqlSeek.MoveNextCallChangeBrowseStateEndSubPrivateSubcmdList_Click()'針對所選的班級，列出班級中所有的學籍信息DimstrSQLIfcboClass.Text="全部"ThenstrSQL="from學生信息表orderbyserial"ElsestrSQL="from學生信息表whereclass='"&cboClass&"'orderbyserial"EndIfDataEnv.rsStudent.CloseDataEnv.rsStudent.Open"select*"&strSQLDataEnv.rssqlSeek.CloseDataEnv.rssqlSeek.Open"selectserial,name"&strSQL'刷新用戶導航的網(wǎng)格控件，并且根據(jù)記錄集中記錄的數(shù)目，來改變各個瀏覽按鈕的狀態(tài)。CallRefreshGridCallChangeBrowseStateCallgrdScan_ChangeEndSubPrivateSubcmdNext_Click()'移動到記錄的下一條DataEnv.rssqlSeek.MoveNextCallChangeBrowseStateEndSubPrivateSubcmdPrevious_Click()'移動到記錄的上一條DataEnv.rssqlSeek.MovePreviousCallChangeBrowseStateEndSubPrivateSubcmdReport_Click()OnErrorResumeNextIfcmdReport.Caption="取消"Then'取消所使用的更新更新DataEnv.rsStudent.CancelUpdate'重新顯示原來數(shù)據(jù)集中的內(nèi)容IfDataEnv.rsStudent.BOFThenDataEnv.rsStudent.MoveFirstElseDataEnv.rsStudent.MovePreviousDataEnv.rsStudent.MoveNextEndIfCallRefreshBindingCallChangeBrowseStatefraSeek.Enabled=TruefraBrowse.Enabled=TruefraInfo.Enabled=FalsegrdScan.Enabled=TruecmdReport.Caption="報表(R)"mbClose=TrueElse'生成報表DimstrSQLAsStringDataEnv.rsrptStudent.ClosestrSQL="select*from學生信息表whereserial='"&txtSerial.Text&"'"DataEnv.rsrptStudent.OpenstrSQLrptStudent.ShowEndIfEndSubPrivateSubcmdSelectPhoto_Click()OnErrorGoToerrHandler:dlgSelect.DialogTitle="選擇該學生的照片"dlgSelect.Filter="所有圖形文件|*.bmp;*.dib;*.gif;*.jpg;*.ico|位圖文件(*.bmp;*.dib)"&_"|*.bmp;*.dib|GIF文件(*.gif)|*.gif|JPEG文件(*.jpg)|*.jpg|圖標文件(*.ico)|*.ico"dlgSelect.ShowOpenIfdlgSelect.FileName=""ThenExitSubimgPhoto.Picture=LoadPicture(dlgSelect.FileName)mstrFileName=dlgSelect.FileNameExitSuberrHandler:MsgBoxErr.Description,vbCritical,"錯誤"EndSubPrivateSubcmdUpdate_Click()'更新所添加或者修改的記錄OnErrorGoToerrHandler:DimstrAsStringstr=txtSerial.TextWithDataEnv.rsStudent.Fields("Serial")=txtSerial.Text.Fields("name")=txtName.Text.Fields("sex")=cboSex.Text.Fields("class")=dcbClass.Text.Fields("birthday")=dtpBirth.Value.Fields("tel")=txtTelephone.Text.Fields("address")=txtAddress.Text.Fields("resume")=txtResume.TextIfmstrFileName<>""ThenCallWriteImage(.Fields("photo"),mstrFileName).UpdateEndWithcmdReport.Caption="報表(&R)"cmdUpdate.Enabled=FalsefraInfo.Enabled=FalsembClose=TrueIfDataEnv.rssqlSeek.State=adStateClosedThenDataEnv.rssqlSeek.Open'刷新右端用以導航的網(wǎng)格控件CallRefreshGrid'根據(jù)記錄集中記錄的個數(shù)，改變各個按鈕的狀態(tài)CallChangeBrowseState'定位到剛剛添加或者修改過的記錄DataEnv.rssqlSeek.MoveFirstDataEnv.rssqlSeek.Find"serial='"&str&"'"fraSeek.Enabled=TruefraBrowse.Enabled=TruegrdScan.Enabled=TrueExitSuberrHandler:MsgBoxErr.Description,vbCritical,"錯誤"EndSubPrivateSubdcbClass_Click(AreaAsInteger)IftxtSerial=""ThentxtSerial=dcbClass.TextEndIfEndSubPrivateSubForm_QueryUnload(CancelAsInteger,UnloadModeAsInteger)IfNotmbCloseThenMsgBox"數(shù)據(jù)正被修改，窗口不能關閉",vbCritical,"錯誤"Cancel=TrueEndIfEndSubPrivateSubfraInfo_DragDrop(SourceAsControl,XAsSingle,YAsSingle)EndSubPrivateSubgrdScan_Change()IfgrdScan.ApproxCount>0ThenCallSeekStudent(grdScan.Columns(0).CellText(grdScan.Bookmark))EndIfEndSubPrivateSubgrdScan_RowColChange(LastRowAsVariant,ByValLastColAsInteger)'當前行改變，則動態(tài)改變所要顯示的記錄IfLastRow<>grdScan.BookmarkThenIfgrdScan.ApproxCount>0ThenCallSeekStudent(grdScan.Columns(0).CellText(grdScan.Bookmark))EndIfEndIfEndSubPrivateSubWriteImage(ByRefFldAsADODB.Field,DiskFileAsString)DimbyteData()AsByte'定義數(shù)據(jù)塊數(shù)組DimNumBlocksAsLong'定義數(shù)據(jù)塊個數(shù)DimFileLengthAsLong'標識文件長度DimLeftOverAsLong'定義剩余字節(jié)長度DimSourceFileAsLong'定義自由文件號DimiAsLong'定義循環(huán)變量ConstBLOCKSIZE=4096'每次讀寫塊的大小SourceFile=FreeFile'提供一個尚未使用的文件號OpenDiskFileForBinaryAccessReadAsSourceFile'打開文件FileLength=LOF(SourceFile)'得到文件長度IfFileLength=0Then'判斷文件是否存在CloseSourceFileMsgBoxDiskFile&"無內(nèi)容或不存在!"ElseNumBlocks=FileLength\BLOCKSIZE'得到數(shù)據(jù)塊的個數(shù)LeftOver=FileLengthModBLOCKSIZE'得到剩余字節(jié)數(shù)Fld.Value=NullReDimbyteData(BLOCKSIZE)'重新定義數(shù)據(jù)塊的大小Fori=1ToNumBlocksGetSourceFile,,byteData()'讀到內(nèi)存塊中Fld.AppendChunkbyteData()'寫入FLDNextiReDimbyteData(LeftOver)'重新定義數(shù)據(jù)塊的大小GetSourceFile,,byteData()'讀到內(nèi)存塊中Fld.AppendChunkbyteData()'寫入FLDCloseSourceFile'關閉源文件EndIfEndSubPrivateFunctionReadImage(blobColumnAsADODB.Field)AsString'取得一個臨時性文件DimstrFileNameAsStringstrFileName="ImageTmp"DimFileNumberAsInteger'文件號DimDataLenAsLong'文件長度DimChunksAsLong'數(shù)據(jù)塊數(shù)DimChunkAry()AsByte'數(shù)據(jù)塊數(shù)組DimChunkSizeAsLong'數(shù)據(jù)塊大小DimFragmentAsLong'零碎數(shù)據(jù)大小DimlngIAsLong'計數(shù)器OnErrorGoToerrHanderChunkSize=2048'定義塊大小為2KIfIsNull(blobColumn)ThenExitFunctionDataLen=blobColumn.ActualSize'獲得圖像大小IfDataLen<8ThenExitFunction'圖像大小小于8字節(jié)時認為不是圖像信息FileNumber=FreeFile'產(chǎn)生隨機的文件號OpenstrFileNameForBinaryAccessWriteAsFileNumber'打開存放圖像數(shù)據(jù)文件Chunks=DataLen\ChunkSize'數(shù)據(jù)塊數(shù)Fragment=DataLenModChunkSize'零碎數(shù)據(jù)IfFragment>0Then'有零碎數(shù)據(jù)，則先讀該數(shù)據(jù)ReDimChunkAry(Fragment-1)ChunkAry=blobColumn.GetChunk(Fragment)PutFileNumber,,ChunkAry'寫入文件EndIfReDimChunkAry(ChunkSize-1)'為數(shù)據(jù)塊重新開辟空間ForlngI=1ToChunks'循環(huán)讀出所有塊ChunkAry=blobColumn.GetChunk(ChunkSize)'在數(shù)據(jù)庫中連續(xù)讀數(shù)據(jù)塊PutFileNumber,,ChunkAry()'將數(shù)據(jù)塊寫入文件中NextlngICloseFileNumber'關閉文件ReadImage=strFileNameExitFunctionerrHander:ReadImage=""EndFunctionPrivateSubimgPhoto_Click()EndSubOptionExplicit'表示當前的用戶類型：0管理員類型的用戶;1學生類型的用戶PublicmnUserTypeAsInteger'表示當前登錄的用戶名PublicmsUserNameAsStringPrivateSubMDIForm_Load()'根據(jù)不同的用戶類型，使相應的菜單項可見SelectCasemnUserTypeCase0:'以管理員身份登錄mnuFind.Visible=TruetlbMain.Buttons.Item(3).Visible=TruetlbMain.Buttons.Item(4).Visible=TrueExitSubCase1:'以學生身份登錄，只能查詢自己的信息mnuFind.Visible=False'“信息查詢”菜單不可見tlbMain.Buttons.Item(3).Visible=False'“信息查詢”按鈕不可見tlbMain.Buttons.Item(4).Visible=False'第二個分隔條不可見ExitSubEndSelectEndSubPrivateSubMDIForm_QueryUnload(CancelAsInteger,UnloadModeAsInteger)IfMsgBox("真的要對出本系統(tǒng)嗎？",vbQuestion+vbYesNo+vbDefaultButton2,"退出")=vbNoThenCancel=1EndIfEndSubPrivateSubmnuAbout_Click()LoadfrmSplashfrmSplash.mbAbout=TruefrmSplash.ShowvbModalEndSubPrivateSubmnuArr_Click()frmMain.Arrange(3)'設置主窗體中所有最小化MDI子窗體圖標重排EndSubPrivateSubmnuCas_Click()frmMain.Arrange(0)'設置主窗體中所有非最小化MDI子窗體層疊顯示EndSubPrivateSubmnuExit_Click()UnloadMeEndSubPrivateSubmnuFind_Click()frmFind.ShowEndSubPrivateSubmnuHori_Click()frmMain.Arrange(1)'設置主窗體中所有非最小化MDI子窗體水平平鋪EndSubPrivateSubmnuLog_Click()IfMsgBox("若重新登錄，所有窗體都將關閉！"&vbCrLf&"是否重新登錄？",_vbQuestion+vbYesNo+vbDefaultButton2,"重新登錄")=vbYesThenUnloadMefrmLogin.ShowEndIfEndSubPrivateSubmnuStudent_Click()LoadfrmStudentfrmStudent.ShowEndSubPrivateSubmnuVer_Click()frmMain.Arrange(2)'設置主窗體中所有非最小化MDI子窗體垂直平鋪EndSubPrivateSubtlbMain_ButtonClick(ByValButtonAsMSComctlLib.Button)SelectCaseButton.KeyCase"Student"mnuStudent_ClickExitSubCase"Find"mnuFind_ClickExitSubCase"Login"mnuLog_ClickExitSubCase"Exit"mnuExit_ClickExitSubEndSelectEndSubOptionExplicit'表示當前用戶登錄所選擇的身份，即用戶類型,0-表示教務管理人員；1-表示學生DimmnUserTypeAsIntegerPrivateSubcmdCancel_Click()UnloadMeEndSubPrivateSubcmdOK_Click()'取得用戶輸入的用戶名和密碼DimuserAsString,pwdAsStringuser=Trim(txtUser)pwd=Trim(txtPwd)'根據(jù)不同的身份，選擇不同的表用以查詢DimrAsNewADODB.RecordsetSetr=DataEnv.rssqlSeekDimstrSQLAsStringSelectCasemnUserTypeCase0:'若身份為管理員strSQL="select*from系統(tǒng)人員表wherename='"&user&"'andpwd='"&pwd&"'"Case1:'若身份為學生strSQL="select*from學生信息表wherename='"&user&"'andserial='"&pwd&"'"EndSelectOnErrorResumeNext'查詢DataEnv.rssqlSeek的狀態(tài)，如果已經(jīng)打開，則先關閉Ifr.State=adStateOpenThenr.Closer.OpenstrSQL'根據(jù)strSQL的內(nèi)容刷新DataEnv.rssqlSeek'用戶密碼錯誤的次數(shù)，如果錯誤次數(shù)超過3次，則退出系統(tǒng)StaticnTryCountAsIntegerIfr.EOFThen'登錄失敗MsgBox"對不起，無此用戶或者密碼不正確！請重新輸入??！",vbCritical,"錯誤"txtUser.SetFocustxtUser.SelStart=0txtUser.SelLength=Len(txtUser)nTryCount=nTryCount+1IfnTryCount>=3ThenMsgBox"您無權操作本系統(tǒng)！",vbCritical,"錯誤"UnloadMeEndIfElse'登陸成功'顯示MDI窗體,并將用戶類型和用戶名傳到MDI窗體中的mnUserType,msUserName中WithfrmMain.mnUserType=mnUserType.msUserName=userEndWithLoadfrmMainfrmMain.ShowUnloadMeEndIfEndSubPrivateSubForm_Load()optUserType(0).Value=TrueEndSubPrivateSuboptUserType_Click(IndexAsInteger)mnUserType=IndexEndSubOptionExplicitPrivateSubCommand1_Click()DimstrCon1AsStringDimstrCon2AsStringOnErrorGoTomyerrIfTrim(Text1.Text)=""OrTrim(Text2.Text)=""ThenIfMsgBox("請輸入查詢條件！",vbInformation,"提示")ThenGoTomyerrEndIfSelectCaseTrim(Combo1.Text)Case"學號"strCon1="Serial"Case"姓名"strCon1="Name"Case"班級"strCon1="Class"Case"生日"strCon1="Birthday"Case"性別"strCon1="Sex"Case"家庭地址"strCon1="Address"Case"電話"strCon1="Tel"EndSelectSelectCaseTrim(Combo4.Text)Case"學號"strCon2="Serial"Case"姓名"strCon2="Name"Case"班級"strCon2="Class"Case"生日"strCon2="Birthday"Case"性別"strCon2="Sex"Case"家庭地址"strCon1="Address"Case"電話"strCon2="Tel"EndSelectDataEnv.rsStudent.CloseDataEnv.rsStudent.Open"select*from學生信息表where"&_strCon1&Trim(Combo2.Text)&"'"&Trim(Text1.Text)_&"'"&""&Trim(Combo3.Text)&""&strCon2&_Trim(Combo5.Text)&"'"&Trim(Text2.Text)&"'"dgdCX.DataMember=""dgdCX.RefreshDataEnv.rsStudent.RequerydgdCX.DataMember="Student"dgdCX.Refreshmyerr:EndSubPrivateSubCommand3_Click()UnloadMeEndSubPrivateSubdgdCX_Click()EndSubPrivateSubForm_Load()'添加Combo1的子項作為查詢標準Combo1.AddItem("學號")Combo1.AddItem("姓名")Combo1.AddItem("班級")Combo1.AddItem("生日")Combo1.AddItem("性別")Combo1.AddItem("家庭地址")Combo1.AddItem("電話")Combo1.ListIndex=0'添加Combo2的子項作為關系符Combo2.AddItem("=")Combo2.AddItem(">")Combo2.AddItem(">=")Combo2.AddItem("<")Combo2.AddItem("<=")Combo2.AddItem("<>")Combo2.ListIndex=0'添加Combo3的子項作為邏輯連接符Combo3.AddItem("And")Combo3.AddItem("Or")Combo3.ListIndex=0'添加Combo4的子項作為第二種查詢標準Combo4.AddItem("學號")Combo4.AddItem("姓名")Combo4.AddItem("班級")Combo4.AddItem("生日")Combo4.AddItem("性別")Combo4.AddItem("家庭地址")Combo4.AddItem("電話")Combo4.ListIndex=0'添加Combo5的子項作為第二種關系符Combo5.AddItem("=")Combo5.AddItem(">")Combo5.AddItem(">=")Combo5.AddItem("<")Combo5.AddItem("<=")Combo5.AddItem("<>")Combo5.ListIndex=0EndSubPrivateSubForm_Unload(CancelAsInteger)frmMain.Enabled=TruefrmMain.ShowEndSub附錄資料：不需要的可以自行刪除VBHOOK(鉤子)超級無敵詳細用法（介紹）hook是WINDOWS提供的一種消息處理機制，它使得程序員可以使用子過程來監(jiān)視系統(tǒng)消息，并在消息到達目標過程前得到處理。

下面將介紹WINNDOWSHOOKS并且說明如何在WINDOWS程序中使用它。關于HOOKS

使用HOOK將會降低系統(tǒng)效率，因為它增加了系統(tǒng)處量消息的工作量。建議在必要時才使用HOOK，并在消息處理完成后立即移去該HOOK。

HOOK鏈

WINDOWS提供了幾種不同類型的HOOKS；不同的HOOK可以處理不同的消息。例如，WH_MOUSEHOOK用來監(jiān)視鼠標消息。

WINDOWS為這幾種HOOKS維護著各自的HOOK鏈。HOOK鏈是一個由應用程序定義的回調(diào)函數(shù)隊列，當某種類型的消息發(fā)生時，WINDOWS向此種類型的HOOK鏈的第一個函數(shù)發(fā)送該消息，在第一函數(shù)處理完該消息后由該函數(shù)向鏈表中的下一個函數(shù)傳遞消息，依次向下。如果鏈中某個函數(shù)沒有向下傳送該消息，那么鏈表中后面的函數(shù)將得不到此消息。（對于某些類型的HOOK，不管HOOK鏈中的函數(shù)是否向下傳遞消息，與此類型HOOK聯(lián)系的所有HOOK函數(shù)都會收到系統(tǒng)發(fā)送的消息）

HOOK過程

為了攔截特定的消息，你可以使用SetWindowsHookEx函數(shù)在該類型的HOOK鏈中安裝你自己的HOOK函數(shù)。該函數(shù)語法如下：

publicfunctionMyHook(nCode,wParam,iParam)aslong

‘加入代碼

endfunction

其中MyHook可以隨便命名，其它不能變。該函數(shù)必須放在模塊段。nCode指定HOOK類型。wParam,iParam的取值隨nCode不同而不同，它代表了某種類型的HOOK的某個特定的動作。

SetWindowsHookEx總是將你的HOOK函數(shù)放置在HOOK鏈的頂端。你可以使用CallNextHookEx函數(shù)將系統(tǒng)消息傳遞給HOOK鏈中的下一個函數(shù)。

[注釋]對于某些類型的HOOK，系統(tǒng)將向該類的所有HOOK函數(shù)發(fā)送消息，這時，HOOK函數(shù)中的CallNextHookEx語句將被忽略。

全局HOOK函數(shù)可以攔截系統(tǒng)中所有線程的某個特定的消息（此時該HOOK函數(shù)必須放置在DLL中），局部HOOK函數(shù)可以攔截指定線程的某特定消息（此時該HOOK函數(shù)可以放置在DLL中，也可以放置在應用程序的模塊段）。

[注釋]建議只在調(diào)試時使用全局HOOK函數(shù)。全局HOOK函數(shù)將降低系統(tǒng)效率，并且會同其它使用該類HOOK的應用程序產(chǎn)生沖突。

HOOK類型

WH_CALLWNDPROC和WH_CALLWNDPROCRETHOOK

WH_CALLWNDPROC和WH_CALLWNDPROCRETHOOK可以監(jiān)視SendMessage發(fā)送的消息。系統(tǒng)在向窗體過程發(fā)送消息前，將調(diào)用WH_CALLWNDPROC；在窗體過程處理完該消息后系統(tǒng)將調(diào)用WH_CALLWNDPROCRET。

WH_CALLWNDPROCRETHOOK會向HOOK過程傳送一個CWPRETSTRUCT結構的地址。該結構包含了窗體過程處理系統(tǒng)消息后的一些信息。

WH_CBTHook

系統(tǒng)在激活，創(chuàng)建，消毀，最小化，最大化，移動，改變窗體前；在完成一條系統(tǒng)命令前；在從系統(tǒng)消息隊列中移去鼠標或鍵盤事件前；在設置輸入焦點前，或同步系統(tǒng)消息隊列前，將調(diào)用WH_CBTHOOK。你可以在你的HOOK過程攔截該類HOOK，并返回一個值，告訴系統(tǒng)，是否繼續(xù)執(zhí)行上面的操作。

WH_DEBUGHOOK

系統(tǒng)在調(diào)用與某種HOOK類型聯(lián)系的HOOK過程前，將調(diào)用WH_DEBUG，應用程序可以使用該HOOK決定是否讓系統(tǒng)執(zhí)行某種類型的HOOK。

WH_FOREGROUNDIDLEHook

系統(tǒng)在空閑時調(diào)用該HOOK，在后臺執(zhí)行優(yōu)先權較低的應用程序。

WH_GETMESSAGEHook

WH_GETMESSAGEHook使應用程序可以攔截GetMessage或PeekMessage的消息。應用程序使用WH_GETMESSAGEHOOK監(jiān)視鼠標、鍵盤輸入和發(fā)送到隊列中的其它消息。

WH_JOURNALRECORDHook

WH_JOURNALRECORDHook使應用程序可以監(jiān)視輸入事件。典型地，應用程序使用該HOOK記錄鼠標、鍵盤輸入事件以供以后回放。該HOOK是全局HOOK，并且不能在指定線程中使用。

WH_JOURNALPLAYBACKHook

`WH_JOURNALPLAYBACKHook使應用程序可以向系統(tǒng)消息隊列中插入消息。該HOOK可以回放以前由WH_JOURNALRECORDHOOK錄制的鼠標、鍵盤輸入事件。在WH_JOURNALPLAYBACKHook安裝到系統(tǒng)時，鼠標、鍵盤輸入事件將被屏蔽。該HOOK同樣是一個全局HOOK，不能在指定線程中使用。

WH_JOURNALPLAYBACKHook返回一個時間暫停值，它告訴系統(tǒng)，在處理當前回放的消息時，系統(tǒng)等待百分之幾秒。這使得此HOOK可以控制在回放時的時間事件。

WH_KEYBOARDHook

WH_KEYBOARDHook使應用程序可以監(jiān)視由GetMessage和PeekMessage返回的WM_KEYDOWN及WM_KEYUP消息。應用程序使用該HOOK監(jiān)視發(fā)送到消息隊列中的鍵盤輸入。

WH_MOUSEHook

WH_MOUSEHook使應用程序可以監(jiān)視由GetMessage和PeekMessage返回的消息。應用程序使用該HOOK監(jiān)視發(fā)送到消息隊列中的鼠標輸入。

WH_MSGFILTERandWH_SYSMSGFILTERHooks

WH_MSGFILTER和WH_SYSMSGFILTERHooks使應用程序可以監(jiān)視菜單、滾動條、消息框、對話框，當用戶使用ALT+TAB或ALT+ESC來切換窗體時，該HOOK也可以攔截到消息。WH_MSGFILTER僅在應用程序內(nèi)部監(jiān)視菜單、滾動條、消息框、對話框，而WH_SYSMSGFILTER則可以在系統(tǒng)內(nèi)監(jiān)視所有應用程序的這些事件。

WH_SHELLHook

一個SHELL程序可以使用WH_SHELLHook來接收重要的信息。當一個SHELL程序被激活前或當前窗體被創(chuàng)建、消毀時，系統(tǒng)會調(diào)用WH_SHELLHook過程。

使用HOOK

安裝、銷毀HOOK過程

監(jiān)視系統(tǒng)事件安裝、銷毀HOOK過程

使用SetWindowsHookEx函數(shù)，指定一個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來當作某個訊息產(chǎn)生時，來處理它的Function，這個HookFunction有一定的叁數(shù)格式

PrivateFunctionHookFunc(ByValnCodeAsLong,_

ByValwParamAsLong,_

ByVallParamAsLong)AsLong

nCode代表是什麼請況之下所產(chǎn)生的Hook，隨Hook的不同而有不同組的可能值。

wParamlParam傳回值則隨Hook的種類和nCode的值之不同而不同。

因這個叁數(shù)是一個Function的Address所以我們固定將HookFunction放在.Bas中，并以AddressOfHookFunc傳入。至於HookFunction的名稱我們可以任意給定，不一定叫HookFunchmod代表.DLL的hInstance，如果是LocalHook，該值可以是Null(VB中可傳0進去)，而如果是RemoteHook，則可以使用GetModuleHandle(".dll名稱")來傳入。dwThreadId代表執(zhí)行這個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，於是產(chǎn)生Hook的一個連線。如果B中不想Pass這訊息給A，那就不要呼叫CallNextHookEx()。DeclareFunctionCallNextHookExLib"user32"Alias"CallNextHookEx"_

(ByValhHookAsLong,_

ByValncodeAsLong,_

ByValwParamAsLong,_

lParamAsAny)AsLonghHook值是SetWindowsHookEx()的傳回值，nCode,wParam,lParam則是HookProcedure中的三個叁數(shù)。最後是將這Hook去除掉，請呼叫UnHookWindowHookEx()DeclareFunctionUnhookWindowsHookExLib"user32"Alias"UnhookWindowsHookEx"

_

(ByValhHookAsLong)AsLonghHook便是SetWindowsHookEx()的傳回值。此時，以上例來說，B程式結束Hook，則換A可以直接攔截訊息。

KeyBoardHook的范例HookFunction的三個叁數(shù)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