Đánh giá chủ đề:
  • 0 Votes - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Vô hiệu hoá nút chuột với record trên Form - không có msgbox
#1
Code này hơi bị dài, các bạn cẩn thận khi sau chép.
Tạo một module mới với tên tuỳ ý. Nội dung code trong module như sau:

Mã PHP:
Option Explicit

Private Declare Function VirtualAlloc Lib "kernel32" (ByVal Address As LongByVal Size As LongByVal AllocationType As LongByVal Protect As Long) As Long
Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal ProcName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal Module As LongByVal ProcName As String) As Long
Private Declare Sub CopyMemoryAnsi Lib "kernel32" Alias "RtlMoveMemory" (ByVal Dest As LongByVal Source As StringByVal Size As Long)
Private Declare 
Sub CastToObject Lib "kernel32" Alias "RtlMoveMemory" (ByRef Dest As ObjectByRef Source As LongByVal Size As Long)

Private Const 
SIZEOF_PTR32              As Long = &H4
Private Const PAGE_EXECUTE_RW           As Long = &H40
Private Const MEM_RESERVE_AND_COMMIT    As Long = &H3000
Private Const ERR_OUT_OF_MEMORY         As Long = &H7

Private Type IDispatchVTable
    QueryInterface 
As Long
    AddRef 
As Long
    Release 
As Long
    GetTypeInfoCount 
As Long
    GetTypeInfo 
As Long
    GetIDsOfNames 
As Long
    Invoke 
As Long
End Type

Public Function NewMouseHook(ByRef Form As Access.Form) As Object

    Dim NativeCode 
As String
    Dim Kernel32Handle 
As Long
    Dim GetProcAddressPtr 
As Long
    Dim MouseHookAddr 
As Long
    Dim MouseHookLoader 
As Object
    Dim LoaderVTable 
As IDispatchVTable
            
    NativeCode 
_
            
"XYQPSWQ[T_S\\[S\XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX- %uUPXX-%ueeT[PXX-E%%ePXX-uu0E-uu0EPXX-eeE%PXX-%e%uPXX-eeE PXX-%eE PXXX@@fX<0tF4+&4+2'&,V/PCp@-''2V/5+1''3V/ys 1S CCCuRfI>_ltcDPC@KCQcBnIAGBqcDPO@GBE@KCqc@YMQHUqp@dQ^AAAAGBUBISExD]MQQ=OYHAQ@\EAA@eiQDeiQHMIqFeiQLMIqHeiQPMIqHeiQTMIqHeiQXucOAAAAMcY^AAAAIsEHDEQCAeE@AeEC?GGCPCXM@BeqDAAoAAEA@KMC@azC@IAaBB@Ax[AABAiqXAqa<QCC@UFLwREHTIAA@AA\jmIPdqpaxBA\\mITdQqcRmiEMKX^AAAAf\MAIAQcP  TKKp>RPQM@JMH@azA@IAaBRCAHAAA@qjE@AA>JAAAxnAA@qCB@AADMAAAtuAA@QTB@AAlNAAAhAAA@UtclNIpt^]P<[VPXKpcEp>bPpQcU ?bM ? ypCAuPqM@n_LKWDBCkoAtTPajbaA@AQ\MmYRxBY_tAQ\DMBqkbp>uPp>u@p>upq>u pcU ??rpscM ??QPucevdqPAAePWtclNIppbG<AAAAhB L@AQWIWE>sA]cE ?bU ?bMpnpDEpU?WE?KWE?KWD>FRaAU<_PxnYRxnYP<[M@Hmy>E ?bU ?bMpnpDE@z?WE?KWE?KWD>FRaAS<_PxnYRxnYP<[M@HMy>E ?bU ?bMpnpDEP^?WE?KWE?KWD>FRaAT=_PxnYRxnYP<[M@HAq>E ?bU ?bMpnpDEP\?WE?KWE?KWD>FRaAK=_PxnYRxnYP<[M@Haz>E ?bU ?bMpnpDE @?WE?KWE?KWD>FRaA@<_PxnYRxnYP<[M@HAq>E ?bU ?bMpnpDE@a?WE?KWE?KWD>FRaAY<_PxnYRxnYP<[M@Hut>E ?b" _
            
"U ?bMpnpDEpW?WE?KWE?KWD>FRaAB>_PxnYRxnYP<[M@Hqq>E ?bU ?bMpnpDE@A?WE?KWE?KWD>FRaAK?_PxnYRxnYP<[M@HUt>E ?bU ?bMpnpDE@B?WE?KWE?KWD>FRaAC?_PxnYRxnYP<[M@HI=?E ?bU ?bMpnpDE@@?WE?KWE?KWD>FRaAK?_PxnYRxnYP<[M@HIp>E ?bU ?bMpnpDEPc?WE?KWE?KWD>FRaAU<_PxnYRxnYP<[M@Hq>?E ?bU ?bMpnpDEpa?WE?KWE?KWD>FRaAz<_PxnYRxnYP<[M@HQq>E ?bU ?bMpnpDE@A?WE?KWE?KWD>FRaAu<_PxnYRxnYP<[M@Hip>E ?bU ?bMpnpDEPo?WE?KWE?KWD>FRaAC=_PxnYRxnYP<[M@HAq>E ?bU ?bMpnpDE@A?WE?KWE?KWD>FRaA@=_PxnYRxnYP<[M@Hmy>E ?bU ?bMpnpDEPP?WE?KWE?KWD>FRaAL=_PxnYRxnYP<[M@Hey>E ?bU ?bMpnpDEpq?WE?KWE?KWD>FRaAC?_PxnYRxnYP<[M@HA=?E ?bU ?bMpnpDE@B?WE?KWE?KWD>FRaAy=_PxnYRxnYP<[M@Hiu>E ?bU ?bMpnpDE@C?WE?KWE?KWD>FRaAt<_PxnYRxnYP<[M@Haq>E ?bU ?bMpnpDEPA?WE?KWE?KWD>FRaAX=_PxnYRxnYP<[M@HMy>E ?bU ?bMpnpDE@q?WE?KWE?KWD>FRaAD=_PxnYRxnYP<[M@HEu>E ?bU ?bMpnpDEp;?WE?KWE?KWD>FRaAs>_PxnYRxnYP<[M@HMy>E ?bU ?bMpnpDE ^?WE?KWE?KWD>FRaAD=_PxnYRxnYP<[M@HAq>E ?bU ?bMpnpDEP\?WE?KWE?KWD>FRaAF=_PxnYRxnYP<[M@Hmy>E ?bU ?bMpnpDEPR?WE?KWE?KWD>FRaAL=_PxnYRxnYP<[M@" _
            
"Hey>E ?bU ?bMpnpDE R?WE?KWE?KWD>FRaAD=_PxNRsIwE<ifL@@Aq[EPNFACMNs^EAIWE=KWD?KwE>FRQEK?_PxnYPxnYT<[M@Buu>E ?bM ?bEpnpDaAE?WE?KWD?KwE>FRQEA?_PxnYPxnYT<[M@Bev>E ?bM ?bEpnpDaAA?WE?KWD=JkAaa>?bE ?bUpNcLIq>E ?bM@>bAEM;HQs>KWD?KwE>HSQE?WE?KWE=KCPqjB@ab>?bM ?bEpNcTaq>E ?bU@>bJE];XAYy?oYPxnYT<cIBB=_PxnYRxnYP<[M@HUv>E ?bU ?bMpnpDEpN?WE?KWE?KWD>FRaAA?_PxnYRxnYP<[M@Hev>E ?bU ?bMpnpDE@@?WE?KWE=JCD@@K??KwE?KWE>HS@C?WE?KWD=KkE@AfOC@G??KWE?KWD>HsaA?WE?KwE=KGE@AbOEd=?bU ?bMpNcDEp>E ?bE@>bPPQqjb@ab>?bM ?bEpNcTaq>E ?bU ?bMpnpDEP\?WE?KWE?KWD>FRaAv=_PxnYRxnYP<[M@HEy>E ?bU ?bMpnpDEP_?WE?KWE?KWD>FRaAH=_PxnYRpjYQHQs>KWD?KwE>HSQE?WE?KWE=KCDCAjOC@K??KwE?KWE>HS@C?WE?KWD=KkECAfOE@G??KWE?KWD>HsaA?WE?KwE=KGECAbOGd=?bU ?bMpNcDEp>E ?bE ?bUpnpDIQ\?WE?KwE?KWE>FRACm=_PxnYTxnYR<[M@QEy>E ?bE ?bUpnpDIQ_?WE?KwE?KWE>FRACL=_PxnYTpjiSLAYy?oYPxnYT<cIBB=_PxnYRpnYQLEM;HQs>KWD?KwE>HSQE?WE?KWE=KCDBAjOE@K??KwE?KWE>HS@C?WE?KWD=KkEBAfOG@G??KWE?KWD>HsaA?WE?KwE?KWE>FRACu<_PxnYTxnYR<[M@QQs>E ?bE ?bUpnpDIqc?WE?KwE?KWE>" _
            
"FRACE<_PxnYTxnYR<[M@Qq>?E ?bE ?bUpnpDIqc?WE?KwE?KWE>FRACP<_PxnYTxnYR<[M@QQq>E ?bE ?bUpnpDIQa?WE?KwE?KWE>FRACB>_PxnYTtnisAJ?@kElcDUHRs^EAABoAd=?bU ?bMpNcDEp>E ?bEP>bPFMyCmcqKsQ LL>Q@E]yBE]?HAYy?oYPxnYT<cIBB=_PxnYRtnYqAF?@ka=bTuIRs^EAAJoAAjNE@K??KwE?KWE>HS@C?WE?KWD<Kk]qbNqKQnI@Usu=G@Qq KQqxb@H?oYTxnYR<cI@Q=_PxnYPxnYT<[M@Bmy>E ?bM ?bEpnpDaQR?WE?KWD?KwE>FRQET=_PxnYPxnYT<[M@Bey>E ?bM ?bEpnpDaQE?WE?KWD?KwE>FRQEK?_PxnYPxnYT<[M@BUu>E ?bM ?bEpnpDaAD?WE?KWD?KwE>FRQEK?_PxnYPxnYT<[M@BAp>E ?bM ?bEpnpDaaU?WE?KWD?KwE>FRQEK?_PxnYPxnYT<[M@Biq>E ?bM ?bEpnpDaq>?WE?KWD?KwE>FRQEQ<_PxnYPxnYT<[M@BQq>E ?bM ?bEpnpDaqM?WE?KWD?KwE>FRQE@>_PxnYPxnYT<[M@Bet>E ?bM ?bEpnpDaQV?WE?KWD?KwE>FRQE[<_PxnYPxnYT<[M@BI=?E ?bM ?bEpnpDaAB?WE?KWD?KwE>FRQE@=_Px>_PtnYPtnR@XG?Q@= aXm>??oYTxnYR<[M@Qmy>E ?bE ?bUpnpDIQR?WE?KwE?KWE>FRACT=_PxnYTxnYR<[M@Q]=?E ?bE ?bUpnpDIQA?WE?KwE?KWE>FRAC@=_PxnYTxnYR<[M@QAq>E ?bE ?bUpnpDIAA?WE?KwE?KWE>FRAC@=_PxnYTxnYR<[M@Qaz>E ?bE ?bUpnpDIaA?WE?KwE?KWE>FRAC@<_PxnYTxnYR<[M@QAq>E ?bE ?b" _
            
"UpnpDIAa?WE?KwE?KWE>FRACK?_PxnYTxnYR<[M@QA=?E ?bE ?bUpnpDIqc?WE?KwE?KWE>FRAC@>_PxnYTxnYR<[M@Qet>E ?bE ?bUpnpDIQV?WE?KwE?KWE>FRAC[<_PxnYTxnYR<[M@QI=?E ?bE ?bUpnpDIAB?WE?KwE?KWE>FRAC@=_PxnYTxnYR<[M@QAx>E ?bEp>bevtqUlIzQlYPHMIqDmIEIWD>KwE>CgF@@UVCKWECKWD>IKE@KC=b@nYR<oYA?GQW]HM@@AHePOTTKs?TCwFD@UvCxKAQ@AYW]ldqLAqcUpqaBRqcReYT<Oi_DAQ\ZezA@AAAKWEBIO= @rQOJ @\HEAGCCM@Al?<CkF@@Uf@KwEBIkE@KwEEAgFA@AAA@UvNAgF@@AAA@UfLAgFC@BAA@UVJAgFB@AAAFTFHKWE>KCD@AKMA@AAAKwEDIGpcEPpcPItcJ=_UDMBqYttWBrAAKwEEAgFA@QaA@UvNAgF@@AAA@UfLAgFC@BAA@UVJAgFB@AAAFTFHKWE>KCD@AKMA@AAAKwEDIGpcEPpcPItcJ=_UDMBqYttWBrAAKwEDGFAA@AAAxKAQ@Ayc@nIqYttWBrAAPWtclFtcE pa@RqcPeYT<oYR<OY_DAQ\ImYPHmYT<giQDmIqKC=bMp>bA=_AYtdqDAAePCXTKs? DR>TKWECCCM@KCPcUp>bMp> yPAAudqcE pcUp^cBPqcMp>?ImYP<OIO@=P aCAA@mYT<Oi_LAqBDSHA@AqcMp>bApqaxpCAt rcUp>bJpq>qpc[<oYP<oIUL=o]pmYR<oYQL=OUHlYT<oiSLMBqIGEJKWD>KkEBCgBAtxqcEp>bPpqcJEtcA=OUHmYT<oiSLmYQ@dYPxnYT<oiSDEY;DFAA@eYRtnYP<?O]LmYT<oiSLmYAPlIE?KDDKWE?KwE<Is_V[LIpDaGA@CAAj@QUS<OyKC=b@nYR" _
            
"<oYA[lYx]HM@@AHeUlIzQlYPHMIqDmIEIWD>KC=b@bZA@@AaYtdqHAAePCXTKs_UKWECCCM@KCPcUp>b@nIqxGAQ@AYW]HME@AHePWtclFtcE pa@RqcPeYT<OY^TEA\JaZA@@AainRA@AqcU@pcJYwayeE\KmYPPmIEfLiOiTFXKwEEKGaXCcfANPFBKWDEKkaXCgfAnTFRKWEEKC YCkF@IPFBKwEEKGaXCcF@iTFLKWDEKkaXCgf@TPFBKWEEKC YCkf@tTFFKwEEKGaXCcFC@UFEKWDFGJQA@AAAsA];ABAA@mYTPmiCfLYOSPvBKWEEKC YCkr]OUYe@AAAKwEEKGaXCcfACPFBKWDEKkaXCgfAcTV_KWEEKC YCkF@RPFBKwEEKGaXCcF@rTVYKWDEKkaXCgf@OPFBKWEEKC YCkf@oTVSKwEEKGaXCcFCLPFBKWDEKkaXCgFClTVMKWEEKC YCkfCLPFBKwEEKGaXCcfClTVGKWDEKkaXCgFB@UVBKWEFGBaA@AAAsA=zVmYT\]mA?????cj@@IAakZqc@nIqsA]W]HMG@AXTKs? Db=bE pa@RqcPeYT<OY^LEqBEkiA@AqcMppay pAthAoNAaA@g_uCAAACwFI@QFCKWDIf\mAAAqcMppcAYNQaAE\OmYT\miCKGEKKCPcU ?zKmYR\mYAKCDKIWD?KwEFKGa<@D@Qt<pcUppcJmYQXmIEIWD<knqcMppcAmIUXeYTtnYR<OYqnDt>u ??UP^cE@>bEp> @>GU?WD=IWEzKWD>AK] @AAAR<_TpfYPhnYR<GYqNCAA@Et>up??UP^cEP_bE@OUjDq>UPo[PlYT KtcJ=_ULmYT<giQLmYP<Wag@AAAP<_TpnYR<oYULeiQdmYP<WQi@AAAPlYR<oYQL=O]d=_TtnYT<oiSLeYQDlYP<WQm@AAAPlYT<oiSL=_]d=_TtnYT<oiSLeYQHlYP" _
            
"<oIQLMbuICDKse]cMp<bEppcPeYTXnYRX>plAubA@@AA?E@\ALI;BQFMHPVDCcoBtHu;ZtsA@@AAtHpahzA\AlORKWDwKkECIwEvkFucE =bP pcJeYR\nOLKWEwO=KUHeYT\nOKKwEwKGECO=KEIWDvkjpcM =L@jYQHeYP\n_BKWDwKkECsAmcAeYP\nYT<oiSLmYP\fYQpmYT<oiSLY]QtEqcEp^@@BAA@At>u ??UP>bUp>bJpQcA@ucEp>bPpqcM@_cJmYP<oIULmYRpfiS<lYP<oIULmYRtfiSxmYP<oIULmYRxfiSXmYP<oIULmYRlfiS\mYP<oIULmYRhfiS lYP<oIULmYRHeiShmYPHmIEKkEFIwEtsA]cE@<bUP<@U@\azYVPXKP\MmYRTNQRPnYP<gYAkrq>E@\a=ALs@AAA<e<?uPl[<oYT<oiSL=_]pmYP<oIUL=oUHlYR<oYULeiQlMBqi>UA@AQ;MDAA@MY^LIqBEOUA@AaXCwFGBQfBfLY^XMA\GYwa=aPAuxucMppay @AthAoNAaA@gOKAAAACwFI@QFHKWDIf\mAKAqcMp>bApAaxPBAtTqaJ>?zBMbuKWEIfdIUHmoCx;@ABAY;tBAA@MBqivOA@AaXCwFGD=P UBAA@mYT\Mi_HEA\JajB@IAai>LA@AqMRfYTLnYR\mYAIWEsKWDsO]jCAgnA@@AA?Y@\LLY;BQvOIPFICgOCtdwaiZA\Hlo_Ag?@@@AAt\paibA\aLY;FQVQkZwcE <bP PcUp=z[lYRHnYQHmIEIWDrkzucM <C?FECIWErkJucU <bJ pB?FQcEp=ztmYTHNRsJkECIwErk^scE <bP pMIjiCIwErkbpcE <C?BDCIWDrkrqcM <bA pB?BPcUp= =qMAOUXqCG_AKWE>KCDBHkELsA=zMazA@IAakZqc@nIqsA=bevdqdAAePCHA@AAA@AAA@iAA" _
            
"@AAA@AAAC@qZ@AFAy@a]@eGAg@A[@QFA @qT@EGAy@aZ@UGA @AU@aGAi@AZ@qGAi@A]@MFA @qJ@ACAi@AT@UGAc@A[@ACAM@QY@MFAt@QX@IFAs@AI@IBApAAM@aBA@AAA@]UXttuZdTFZe TYnPGZeDEAOpUPsIBAOpUPATF\sIBAC<vPePVRapGZoLGAULTPRLbM@MUYlpwTixGXo\FUr<vYA@qUePvTixGXo\FRoxwXA@aTiHF\uDGZFHVXe@AA0"
 
           
    
' Allocate the executable memory for the object
        MouseHookAddr = VirtualAlloc(0, Len(NativeCode), MEM_RESERVE_AND_COMMIT, PAGE_EXECUTE_RW)

    If MouseHookAddr <> 0 Then
    
        ' 
Copy the x86 native code into the allocated memory
            Call CopyMemoryAnsi
(MouseHookAddrNativeCodeLen(NativeCode))
 
             
        
' Force the memory address into an Object variable (also triggers the shell code)
            LoaderVTable.QueryInterface = MouseHookAddr
            Call CastToObject(MouseHookLoader, VarPtr(VarPtr(LoaderVTable)), SIZEOF_PTR32)
            If Not TypeOf MouseHookLoader Is VBA.Collection Then
                Set NewMouseHook = (MouseHookLoader)
                Set MouseHookLoader = Nothing
            End If
            
        ' 
Initialize our COM object
            Kernel32Handle 
GetModuleHandleA("kernel32")
 
           GetProcAddressPtr GetProcAddress(Kernel32Handle"GetProcAddress")
 
           Call NewMouseHook.Init(Kernel32HandleGetProcAddressPtrForm.hwnd)
 
           
        
' Disable the scroll wheel by default.
            NewMouseHook.Scroll = False
        
    Else
    
        Err.Raise ERR_OUT_OF_MEMORY
    
    End If
    
End Function 

      Tại form muốn vô hiệu hoá nút chuột xử lý code event Form_Load hoặc Form_Open như sau:

Mã PHP:
Option Compare Database

Private MouseHook As Object
    
Private Sub Form_Load()
 
   Set MouseHook NewMouseHook(Me)
 
   MouseHook.Scroll False
End Sub 

Với 2 đoạn mã này Form sẽ lạnh lùng làm đơ nút chuột, khi xoay không bị chạy record
demo
Chữ ký của tranthanhan1962 Kết quả cuối cùng của một đời người, không phải bạn có được bao nhiêu tiền bạc, tài sản. Mà bạn còn bao nhiêu người bạn  thumbs up
ღღღღღTài sản của tranthanhan1962 (View All Items) ღღღღღ
Reply
Những người đã cảm ơn maidinhdan , Noname


Có thể liên quan đến chủ đề
Chủ đề: Tác giả Trả lời: Xem: Bài mới nhất
  [Hỏi] Refresh Form và tiếp tục hoạt động Godspear 2 84 08-12-16, 12:48 PM
Bài mới nhất: Godspear
  Tạo Menu dạng TreeView bằng Query (không dùng ActiveX) ongke0711 4 268 06-12-16, 09:16 PM
Bài mới nhất: toancvp
  [Hỏi] Cách thêm dữ liệu vào form Main_Sub NganNguyen 1 39 06-12-16, 02:23 AM
Bài mới nhất: maidinhdan
  Tự động hiện Form khi loading hết thời gian ChiMai 1 49 02-12-16, 08:59 PM
Bài mới nhất: ongke0711
Photo [Hỏi] Mở Form trên access 2007 báo lỗi jason 5 195 22-11-16, 09:23 AM
Bài mới nhất: jason

Chuyển nhanh:


User(s) browsing this thread: 1 Guest(s)
Diễn Đàn Thơ Văn Thi Ẩm Lâu|Nhà Hàng Sông Thơ