CLEAR ALL
CLEAR
LOCAL oEvents
LOCAL oRS AS adodb.recordset
LOCAL oConn AS adodb.Connection
SET ASSERTS ON
oEvents = NEWOBJECT("MyClass")
oConn = NEWOBJECT("adodb.connection")
oConn.Open("Provider=VFPOLEDB.1;Data Source="+HOME(2)+"northwind")
oRS = oConn.Execute("select * from customers")
fUseMyHandler=.t. && change this to use the custom handler below or the native VFP handler
IF fUseMyHandler
oEventEx=CREATEOBJECT("EventHandlerEx")
oEventEx.EVENTHANDLER(oRS, oEvents)
ELSE
? EVENTHANDLER(oRS, oEvents)
ENDIF
?
? PADR(oRS.Fields(0).Value,20)
IF fUseMyHandler
oEventEx.EVENTHANDLER(oRS, oEvents,.t.) && unbind
ELSE
? EVENTHANDLER (oRS, oEvents, .T.)
ENDIF
oRS.MoveNext
? PADR(oRS.Fields(0).Value,20)
oRS.MoveNext
? PADR(oRS.Fields(0).Value,20)
CLEAR ALL
DEFINE CLASS EventHandlerEx as Custom
hProcHeap =0
dwCookie=0 && IConnectionPoint->Advise cookie
oCOMVFP=null
hr=0 && HResult
cError=0 && addr of error
PROCEDURE init
DECLARE integer LoadLibrary IN WIN32API string
DECLARE integer FreeLibrary IN WIN32API integer
DECLARE integer GetProcAddress IN WIN32API integer hModule, string procname
DECLARE integer GetProcessHeap IN WIN32API
DECLARE integer HeapAlloc IN WIN32API integer hHeap, integer dwFlags, integer dwBytes
DECLARE integer HeapFree IN WIN32API integer hHeap, integer dwFlags, integer lpMem
DECLARE integer CLSIDFromString IN ole32 string lpszProgID, string @ strClSID
DECLARE integer SysAllocString IN oleaut32 string wstr
DECLARE integer SysFreeString IN oleaut32 integer bstr
DECLARE integer EnumChildWindows IN WIN32API integer hWnd, integer lpEnumProc, integer lParam
CREATE CURSOR memAllocs (memPtr i, AllocType c(1)) && track mem allocs that need to be freed: H=Heap,B=BSTR,L=Library
this.hProcHeap = GetProcessHeap()
PROCEDURE EVENTHANDLER(oSrc as Object, oSink as Object,fUnbind as Boolean)
CREATE table jumps (cLabel c(20),cFlag c(1),sCodePos i) && cFlag="D" defined, "R", reference
INDEX on cLabel+cFlag TAG cLabel
this.hr=this.MakeStr(REPLICATE(CHR(0),4)) && allocate space for HResult
this.cError=this.MakeStr(REPLICATE(CHR(0),4)) && Allocate space for error string
nLocals=10
sCode=""
sCode = sCode + CHR(0x55) && push ebp
sCode = sCode + CHR(0x8b) + CHR(0xec) && mov ebp, esp
sCode = sCode + CHR(0x81) + CHR(0xec)+BINTOC(nLocals * 4, "4rs") && sub esp, nLocals
* sCode = sCode + CHR(0xcc) && int 3 DebugBreak() to attach a debugger
*sCode = sCode + CHR(0xb8) + CHR(5)+CHR(0x40)+CHR(0)+CHR(0x80) && mov eax, 0x80004005 && pretend error msg to test err handling
*!* sCode = sCode + CHR(0x6a) + CHR(0x00) && push 0
*!* sCode = sCode + this.CallDllFunction("MessageBeep", "user32") && MessageBeep(0)
*hr = oSrc->QueryInterface(IID_IConnectionPointContainer,&pcpc) //First QI the oSrc for IConnectionPointContainer
sCode = sCode + CHR(0x8d) + CHR(0x45)+CHR(0xf0) && lea eax, [ebp-10h] && addr to put pConnectionPointContainer
sCode = sCode + CHR(0x50) && push eax
cIid=SPACE(16)
CLSIDFromString(STRCONV("{B196B284-BAB4-101A-B69C-00AA00341D07}"+CHR(0),5),@cIid) && IID_IConnectionPointContainer
sCode = sCode + CHR(0xb8) + BINTOC(this.MakeStr(cIid),"4rs") && mov eax, str
sCode = sCode + CHR(0x50) && push eax
sCode = sCode + CHR(0xb8) + BINTOC(SYS(3095,oSrc),"4rs") && mov eax, oSrc: the IDispatch for oSrc for THIS pointer
sCode = sCode + CHR(0x50) && push eax
sCode = sCode + CHR(0x8b) + CHR(0) && mov eax, [eax] && get the vTable
sCode = sCode + CHR(0xff) + CHR(0x50) + CHR(0x00) && call [eax+0h] && call indirect the function at 0h in the vTable, which is QI
sCode = sCode + CHR(0x83) + CHR(0xf8) + CHR(0x00) && cmp eax, 0 && if hr = SUCCESS
* jne FailedQICPC
sCode = sCode + CHR(0x75)+CHR(0x00) && jne nBytes && nBytes calc'd below. je= 0x74, Jump if Equal, jne = 0x75
INSERT INTO jumps values ("FailedQICPC","R",LEN(sCode)) && refer to a label to jump to at this pos
*hr= pcpc->FindConnectionPoint( IID_IRecordSet,&pcp) // get the pConnectionPoint
sCode = sCode + CHR(0x8d) + CHR(0x45)+CHR(0xec) && lea eax, [ebp-14h] && addr to put pcp COM ptr
sCode = sCode + CHR(0x50) && push eax
CLSIDFromString(STRCONV("{00000266-0000-0010-8000-00AA006D2EA4}"+CHR(0),5),@cIid) && IID for RecordSetEvents
sCode = sCode + CHR(0xb8) + BINTOC(this.MakeStr(cIid),"4rs") && mov eax, str
sCode = sCode + CHR(0x50) && push eax
sCode = sCode + CHR(0x8b) + CHR(0x45) + CHR(0xf0) && mov eax, [ebp-10h] ; pCPC
sCode = sCode + CHR(0x50) && push eax && push the THIS ptr
sCode = sCode + CHR(0x8b) + CHR(0) && mov eax, [eax] && get the vTable
sCode = sCode + CHR(0xff) + CHR(0x50) + CHR(0x10) && call [eax+4*4h] FindConnectionPoint is 4th entry in vtable
sCode = sCode + CHR(0x83) + CHR(0xf8) + CHR(0x00) && cmp eax, 0 && if hr = SUCCESS
* jne FailedFindCPC
sCode = sCode + CHR(0x75)+CHR(0x00) && jne nBytes && nBytes calc'd below. je= 0x74, Jump if Equal, jne = 0x75
INSERT INTO jumps values ("FailedFindCPC","R",LEN(sCode)) && refer to a label to jump to at this pos
*now QI the fox object for the sink interface
*hr = oSrc->QueryInterface(IID_RecordSetEvents,&pRSEvents)
sCode = sCode + CHR(0x8d) + CHR(0x45)+CHR(0xe8) && lea eax, [ebp-18h] && addr to put pRSEvents COM ptr
sCode = sCode + CHR(0x50) && push eax
sCode = sCode + CHR(0xb8) + BINTOC(this.MakeStr(cIid),"4rs") && mov eax, str
sCode = sCode + CHR(0x50) && push eax
*We must get the IDispatch COM interface for the VFP obj
IF ISNULL(this.oCOMVFP)
fGotit=.f.
FOR i = 1 TO _vfp.Objects.count
TRY
this.oComVFP=_vfp.Objects(i)
fGotit=LOWER(this.oComVFP.name) ="myclass"
CATCH
ENDTRY
IF fGotit
EXIT
ENDIF
ENDFOR
ENDIF
sCode = sCode + CHR(0xb8) + BINTOC(SYS(3095,this.oComVFP),"4rs") && mov eax, oSink: the THIS pointer
sCode = sCode + CHR(0x50) && push eax
sCode = sCode + CHR(0x8b) + CHR(0) && mov eax, [eax] && get the vTable
sCode = sCode + CHR(0xff) + CHR(0x50) + CHR(0x00) && call [eax+0h] && call indirect the function at 0h in the vTable, which is QI
sCode = sCode + CHR(0x83) + CHR(0xf8) + CHR(0x00) && cmp eax, 0 && if hr = SUCCESS
* jne FailedSinkIntface
sCode = sCode + CHR(0x75)+CHR(0x00) && jne nBytes && nBytes calc'd below. je= 0x74, Jump if Equal, jne = 0x75
INSERT INTO jumps values ("FailedSinkIntface","R"