30/05/2016, 23:25
atoz112
sayın kdr20_88,
bahsettiğiniz talebinize yönelik olarak,
elbette sayın Mecnun24 bey tarafından daha net açıklamalar edinmeniz muhtemeldir fakat naçizane kendi düşüncem olarak aşağıdaki açıklamanın yapılması uygun görülmüştür.
bir ihtimal;
içeriğinde yer alan basMouseHook adlı Modül'ün DECLARE edilmesi gereken fonksiyonlarının PTRSAFE kullanımı olmaksızın direkt 32 Bit üzerine mevcut olmasından kaynaklı olduğunu düşünmekteyim.
kısa süreli bir inceleme neticesinde,başka fonksiyon içeren kod satırları olmadığı gerekçesi ile;sadece bu modülün içeriğinin aşağıda yer alan kodlar ile TAMAMEN değiştirilmesi akabinde tekrar deneyiniz.
bilginize...iyi çalışmalar,saygılar.
bahsettiğiniz talebinize yönelik olarak,
elbette sayın Mecnun24 bey tarafından daha net açıklamalar edinmeniz muhtemeldir fakat naçizane kendi düşüncem olarak aşağıdaki açıklamanın yapılması uygun görülmüştür.
bir ihtimal;
içeriğinde yer alan basMouseHook adlı Modül'ün DECLARE edilmesi gereken fonksiyonlarının PTRSAFE kullanımı olmaksızın direkt 32 Bit üzerine mevcut olmasından kaynaklı olduğunu düşünmekteyim.
kısa süreli bir inceleme neticesinde,başka fonksiyon içeren kod satırları olmadığı gerekçesi ile;sadece bu modülün içeriğinin aşağıda yer alan kodlar ile TAMAMEN değiştirilmesi akabinde tekrar deneyiniz.
Kod:
Option Compare Database
Option Explicit
' *****************************************************************************
' * ------------ MOUSE HOOK for Microsoft(r) Access VBA ------------ *
' * ------------ (c) Wayne Phillips / iTech Masters 2009 ------------ *
' * ------------ http://www.everythingaccess.com ------------ *
' *****************************************************************************
' * *
' * This module exposes a function that creates an in-memory, COM-compatible *
' * object that is written in native x86 code rather than VBA. *
' * *
' * The purpose of this module is to allow easy disabling of the mouse scroll *
' * wheel in Forms, without needing a DLL and without VBA problems usually *
' * associated with subclassing windows: *
' * http://support.microsoft.com/?kbid=278379 *
' * *
' * - v1.2 28/08/2009 - now compatible with both VBA5 and VBA6 (Access 97+) *
' * *
' * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*
' * All the benefits of using a native compiled DLL - without needing a DLL! *
' * *
' * You are free to include this module in your project provided that you *
' * leave this copyright notice in place and that no modifications are made. *
' * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*
' * Instructions: *
' * *
' * Add the following code to your OnOpen event: *
' * *
' * Private Sub Form_Open(Cancel As Integer) *
' * Static MouseHook As Object *
' * Set MouseHook = NewMouseHook(Me) *
' * End Sub *
' * *
' *****************************************************************************
#If VBA7 Then
Private Declare Function VirtualAlloc Lib "kernel32" (ByVal Address As LongPtr, ByVal Size As LongPtr, ByVal AllocationType As LongPtr, ByVal Protect As LongPtr) As LongPtr
Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal ProcName As String) As LongPtr
Private Declare Function GetProcAddress Lib "kernel32" (ByVal Module As LongPtr, ByVal ProcName As String) As LongPtr
Private Declare Sub CopyMemoryAnsi Lib "kernel32" Alias "RtlMoveMemory" (ByVal Dest As LongPtr, ByVal Source As String, ByVal Size As LongPtr)
Private Declare Sub CastToObject Lib "kernel32" Alias "RtlMoveMemory" (ByRef Dest As Object, ByRef Source As LongPtr, ByVal Size As LongPtr)
Private Const SIZEOF_PTR32 As LongPtr = &H4
Private Const PAGE_EXECUTE_RW As LongPtr = &H40
Private Const MEM_RESERVE_AND_COMMIT As LongPtr = &H3000
Private Const ERR_OUT_OF_MEMORY As LongPtr = &H7
Private Type IDispatchVTable
QueryInterface As LongPtr
AddRef As LongPtr
Release As LongPtr
GetTypeInfoCount As LongPtr
GetTypeInfo As LongPtr
GetIDsOfNames As LongPtr
Invoke As LongPtr
End Type
#Else
Private Declare Function VirtualAlloc Lib "kernel32" (ByVal Address As Long, ByVal Size As Long, ByVal AllocationType As Long, ByVal 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 Long, ByVal ProcName As String) As Long
Private Declare Sub CopyMemoryAnsi Lib "kernel32" Alias "RtlMoveMemory" (ByVal Dest As Long, ByVal Source As String, ByVal Size As Long)
Private Declare Sub CastToObject Lib "kernel32" Alias "RtlMoveMemory" (ByRef Dest As Object, ByRef Source As Long, ByVal 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
#End If
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@qbE@AA>JAAAxnAA@qCB@AADMAAAtuAA@QTB@AAONAAAhAAA@UtclNIpt^]P<[VPXKpcEp>bPpQcU ?bM ? ypCAuPqM@n_LKWDBCkoAtTPajbaA@AQ\MmYRxBY_tAQ\DMBqkbp>uPp>u@p>upq>u pcU ??rpscM ??QPucevdqPAAePWtclNIppbG<AAAAhR<K@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[EPNFACM]r^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?@kElcDUHar^EAABoAd=?bU ?bMpNcDEp>E ?bEP>bPFMyCmcqKsQ @K>Q@E]yBE]?HAYy?oYPxnYT<cIBB=_PxnYRtnYqAF?@ka=bTuIar^EAAJoAAjNE@K??KwE?KWE>HS@C?WE?KWD<Kk]qbNqKQnI@UCi=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@@AaizJA@AqcU@pcJYwayeU\=lYPPmIEfLi_ByW\qmYRPmYAfLI_DeW\emYTPmiCfLY_FQV\YmYPPmIEfLi_HAQ\MmYR\]]AAAAA@MBqkZvcU@pcJYwayMT\UlYPPmIEfLi_BMW\IlYRPmYAfLI_DIV\=lYTPmiCfLY_F=V\qmYPPmIEfLi_HqW\emYRPmYAfLI_JqW\YmYTPmiCfLY_LAQ\MmYP\]MABAAA@MBqkZpcUpppB=????OoFAaA@oo@KC=b@NBqYtdqXAAePWtclNIpHnYPHMIqDmIEIWD>CwFBA=P HKAA@mYR\MY_HMA\JajB@IAai><@@Aqa=ACAt pcU@cXGJQA@mYR\mYAvBUI@PvBKWDFKkqcA rcPeYTxn?BKwEFKGqcP RcU ?bMppcAYNQQAE\OmYT\miCKGEGKCPcUP>zKmYR\mYAKCDGIWD<KwE>CGmZQ<_\x>_TtfYPpnYP<OIq?At>U@^cEp?bUp^aBVIA@AaU?WD=IWE;KwE>AGmb@AAAQ<_\l>_TtfYPdvYP Cd[A=_TdjGUKWDyRliC?GDBKWD>IKEBKWE>EiHA@AAU?WD=KwE>KGDBIKEHKWE>EEKA@AAUKwE>KGEB?CFH?WD<KWD>KkEBIGEPKWE>EEJA@AAUKWD>KkEB?GFH?WD<KWD>KkEBIGESKWE>KCEBsI\cP rMIfYR\nYP\mIEIWDwKwEwO]ZA=HAQ@Aq^QQVQCcoAt@BStTpahzA\BloWmMAQ@AA\RMI;NQVQkrucU =bJ PcMp<zAlYPXnIUHmiCIwEvkRrcE =C?BDCIWDvkbscM =bA pB?BPcUp<zZmYRXNBqJGEC" & _
"IWEvkvqcU =bJ pM@jYAIWEvKWD>KkEBKWEvIGEMKWD>KkEBFFELAmYP<WAq@AAAP<_\x>_TtnYT<oiSLeYQ@lYP<oIULmYR giCKWE>KCDBKwE=IkENKWE>KCDBKwE<IkEOKWE>KCDBKwE?IkEGKWE>KCDBKwEzIkEFKWE>KCDBKwE;IkEIKWE>KCDBKwECIkEKKWECKCpcJpPcMP<L@fYPPnYTTNQTPFiOvTEgRUvCKwEtCuEuKWE>IGq>E@\a=ALs@AAA<m<?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=bevdqdAAe@AAA@AAA@AaC@AAA@AAA@MEAo@A]@eFAr@Q[@]GAh@A\@ACAW@QY@eFAn@QX@ACAP@A[@eGAl@AZ@eGAp@q]@ACAoAAI@eGAT@QX@MGAh@AI@uEAa@q]@QFAe@a]@MFA @aM@ABApAAO@AAA@AqPePVRoPW\lTGSaxGXlTWQ@=DRELbM@=DREDU\" & _
"tLbM@MuZGTG\MDGZl<vY@UtUEHtMrAqQapGZWdgZd<v\PHvZcDEASTG\WdgZd<v\L<fZgDEAVdg]tTVYlXe]eTGA0"
' 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(MouseHookAddr, NativeCode, Len(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(Kernel32Handle, GetProcAddressPtr, Form.hwnd)
' Disable the scroll wheel by default.
NewMouseHook.Scroll = False
Else
Err.Raise ERR_OUT_OF_MEMORY
End If
End Functionbilginize...iyi çalışmalar,saygılar.