The EventHandler function allows you to connect some code to an object’s event interface. For example, Word allows you to run code when the user changes the Selected text in a document. An ADODB Recordset will fire events, such as WillMove and MoveComplete when moving from record to record.

The EventHandler function takes 2 objects as parameters: the event source, like Word or a RecordSet, and the event sink, like the code you’d like to run. Your event sink code must Implement an interface  defined by the source.

 

EventHandler then does some handshaking between the two to get the events working.

  • It queries the Source for IConnectionPointContainer,
  • then uses that to call EnumConnectionPoints to enumerate the connection points.
  • The sink object is queried for the interface of each found connection point to see if it’s implemented.
  • If found, then the IConnectionPoint->Advise method is called to start the event handling.

 

The sample below creates an ADODB Recordset and makes a few calls to MoveNext, with and without an event sink attached. You can change the event sink connection to be the VFP native EventHandler function, or you can use the generated machine code to show how it works. Both ways return the same results.

 

Here are a couple issues:

  • We need a COM interface to the Event Sink (“myclass”) , which is not a COM object. We get that from the _VFP.Objects collection, which is using COM
  • We need a way to call generated machine code. I used the EnumChildWindows function, which is relatively painless. I just pass it the address of the code to execute as the EnumChildWindowProc, which returns False, so that it’s only called once.
  • The code has a lot of conditional jumps and some error checking. The jumping needs to be resolved in a 2 pass assembler. That’s what the Jump table does. It records the definitions and references of labels, then after the code is generated, the table is scanned for jump address fixups. Most assemblers use two passes.
  • The sample code is a little different from the native VFP EventHandler function: it doesn’t enumerate all the connection points, but rather does a FindConnectionPoint for the particular RecordSetEvents interface.

 

 

You can modify the sample to bind events in other scenarios. For example, I’ve found some objects may not work properly with EnumConnectionPoints, but work only with FindConnectionPoint. Other people have reported that the object may not have a Source interface, but do implement IConnectionPointContainer on other interfaces.

For example, oleview and navigate to Microsoft Word 11.0 Object library and dbl-click. Navigate to CoClass, CoClass Application

 

coclass Application {

    [default] interface _Application;

    [source] dispinterface ApplicationEvents;

    [source] dispinterface ApplicationEvents2;

    [source] dispinterface ApplicationEvents3;

    [default, source] dispinterface ApplicationEvents4;

};

 

 

The Word typelibrary shows that the Application interface sources some event interfaces.

If you look at c:\windows\system32\msfeeds.dll (which comes from installing IE7 beta 2) via OleView, there are no Source interfaces. However, you can call the GetWatcher method (the 24th vTable entry (offset 0x60)) of the IFeedFolder object to get a ConnectionPointContainer object.

 

As an exercise to the reader (Craig: this means you!), modify the sample code to connect events for RSSFeeds.

 

 

See also:

Binding to Internet Explorer Instances

Binding to Internet Explorer events: bug in Typelibrary

For a full sample of generating machine code on a background thread, see Webcrawl a blog to retrieve all entries locally: RSS on steroids

 

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",LEN(sCode)) && refer to a label to jump to at this pos

                                                *hr = pcp->Advise(pSink, &dwCookie)      && Advise if 5th entry in vtable

                                                IF NOT fUnbind

                                                          dwCookieAddr=this.MakeStr(REPLICATE(CHR(0),4))        && place to put the cookie as a string

                                                          sCode = sCode + CHR(0x8d) + CHR(0x05) + BINTOC(dwCookieAddr,"4rs")         && lea eax,dwCookieAddr ;addr to put dwCookie

                                                          sCode = sCode + CHR(0x50)         && push eax

                                                          sCode = sCode + CHR(0x8b) + CHR(0x45) + CHR(0xe8) && mov eax, [ebp-18h]         && the oSink

                                                          sCode = sCode + CHR(0x50)         && push eax  

                                                          sCode = sCode + CHR(0x8b) + CHR(0x45) + CHR(0xec) && mov eax, [ebp-14h] ; pcp

                                                          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(0x14) && call  [eax+ 5*4h] && advise is 5th entry in vtable

                                                ELSE && we're unbinding

                                                          *hr = pcp->UnAdvise(dwCookie)

                                                          sCode = sCode + CHR(0xb8) + BINTOC(this.dwCookie,"4rs")     && mov eax, dwCookieAddr

                                                          sCode = sCode + CHR(0x50)         && push eax  

                                                          sCode = sCode + CHR(0x8b) + CHR(0x45) + CHR(0xec) && mov eax, [ebp-14h]         ;pcp

                                                          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(0x18) && call  [eax+ 6*4h] && unadvise is 6th entry in vtable

                                                ENDIF

                                                sCode = sCode + CHR(0x83) + CHR(0xf8) + CHR(0x00)  && cmp eax, 0          && if hr != SUCCESS

                                                * je GotAdviseUnadvise       ; now we jump if we succeed

                                                sCode = sCode + CHR(0x74)+CHR(0x00)   && je nBytes && nBytes calc'd below. je= 0x74, Jump if Equal, jne = 0x75

                                                INSERT INTO jumps values ("GotAdviseUnadvise","R",LEN(sCode))        && refer to a label to jump to at this pos

                                                          *now save hr and gen err message

                                                          sCode = sCode + CHR(0xa3) + BINTOC(this.hr,"4rs")     && mov this.hr,eax

                                                          sCode = sCode + CHR(0xb8) + BINTOC(this.MakeStr(jumps.cLabel),"4rs") && mov eax, str

                                                          sCode = sCode + CHR(0xa3) + BINTOC(this.cError,"4rs")          && mov this.cError,eax

                                                INSERT INTO jumps values ("GotAdviseUnadvise","D",LEN(sCode))       && define a label at this pos

                                               

                                                sCode = sCode + CHR(0xEb) + CHR(0)     && jmp around else clause

                                                INSERT INTO jumps values ("GotSinkIntface","R",LEN(sCode))   && refer to a label to jump to at this pos

 

                                      *else { // FailedSinkIntface

                                                INSERT INTO jumps values ("FailedSinkIntface","D",LEN(sCode))          && define a label at this pos

                                                *now save hr and gen err message

                                                sCode = sCode + CHR(0xa3) + BINTOC(this.hr,"4rs")     && mov this.hr,eax

                                                sCode = sCode + CHR(0xb8) + BINTOC(this.MakeStr(jumps.cLabel),"4rs")          && mov eax, str

                                                sCode = sCode + CHR(0xa3) + BINTOC(this.cError,"4rs")          && mov this.cError,eax

                                      *}

                                      INSERT INTO jumps values ("GotSinkIntface","D",LEN(sCode))   && define a label at this pos

                                      *pCP->Release()

                                      sCode = sCode + CHR(0x8b) + CHR(0x45) + CHR(0xec) && mov eax, [ebp-14h]

                                      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(0x8)    && call  [eax+8h]

                                      sCode = sCode + CHR(0xEb) + CHR(0)     && jmp around else clause

                                      INSERT INTO jumps values ("GotFindCPC","R",LEN(sCode))        && refer to a label to jump to at this pos

                             *else { // FailedFindCPC

                                      INSERT INTO jumps values ("FailedFindCPC","D",LEN(sCode))     && define a label at this pos

                                      *now save hr and gen err message

                                      sCode = sCode + CHR(0xa3) + BINTOC(this.hr,"4rs")     && mov this.hr,eax

                                      sCode = sCode + CHR(0xb8) + BINTOC(this.MakeStr(jumps.cLabel),"4rs")      && mov eax, str

                                      sCode = sCode + CHR(0xa3) + BINTOC(this.cError,"4rs")          && mov this.cError,eax

                             *}

                             INSERT INTO jumps values ("GotFindCPC","D",LEN(sCode))        && define a label at this pos

                             *pCPC->Release()

                             sCode = sCode + CHR(0x8b) + CHR(0x45) + CHR(0xf0) && mov eax, [ebp-10h]

                             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(0x8)    && call  [eax+8h]

                             sCode = sCode + CHR(0xEb) + CHR(0)     && jmp around else clause

                             INSERT INTO jumps values ("GotQICPC","R",LEN(sCode)) && refer to a label to jump to at this pos

                   *else { //FailedQICPC

                             INSERT INTO jumps values ("FailedQICPC","D",LEN(sCode))       && define a label at this pos

                             *now save hr and gen err message

                             sCode = sCode + CHR(0xa3) + BINTOC(this.hr,"4rs")     && mov this.hr,eax

                             sCode = sCode + CHR(0xb8) + BINTOC(this.MakeStr(jumps.cLabel),"4rs")      && mov eax, str

                             sCode = sCode + CHR(0xa3) + BINTOC(this.cError,"4rs")          && mov this.cError,eax

                   *}

                   INSERT INTO jumps values ("GotQICPC","D",LEN(sCode)) && define a label at this pos

                   sCode = sCode + CHR(0x33) + CHR(0xc0)          && xor eax,eax        && make return value 0 so won't enum any more windows

                   sCode = sCode + CHR(0x8b) + CHR(0xe5)          && mov esp, ebp

                   sCode = sCode + CHR(0x5d)                                      && pop ebp             

                   sCode = sCode + CHR(0xc2)+CHR(0x08)+CHR(0x00)      && ret 8        && EnumChildProc has 2 parms:  pop 2 args=8 bytes

                   USE jumps AGAIN IN 0 ORDER 1 ALIAS jumpdefs

                   SCAN FOR cFlag="R" && look for all references

                             =SEEK(jumps.cLabel+"D","jumpdefs")

                             sCode=LEFT(sCode,jumps.sCodePos-1)+CHR(jumpdefs.sCodePos - jumps.sCodePos) + SUBSTR(sCode,jumps.sCodePos+1) && now fix up the jump location to jump to the definition

                   ENDSCAN

                   AdrCode=this.memAlloc(LEN(sCode),sCode)         && allocate memory for the code

                   EnumChildWindows(_screen.HWnd,AdrCode,0)      && EnumChildWindows needs a callback function. We'll give it our code.Added benefit: Win32 Exception handling of Declare dll

                   IF NOT fUnBind

                             this.dwCookie=CTOBIN(SYS(2600,dwCookieAddr,4),"4rs")

                   ENDIF

                   IF CTOBIN(SYS(2600,this.cError,4),"4rs")!=0

                             ?"Error Location=",SYS(2600,CTOBIN(SYS(2600,this.cError,4),"4rs"),20),TRANSFORM(CTOBIN(SYS(2600,this.hr,4),"4rs"),"@0x")

                   ENDIF

                   USE IN jumpdefs

                   USE IN jumps         

          PROCEDURE MemAlloc(nSize as Integer, cStr as String) as Integer

                   LOCAL nAddr

                   nAddr = HeapAlloc(this.hProcHeap, 0, nSize)        && allocate memory

                   ASSERT nAddr != 0 MESSAGE "Out of memory"

                   INSERT INTO memAllocs VALUES (nAddr,"H")       && track them for freeing later

                   SYS(2600,nAddr, LEN(cStr),cStr)              && copy the string into the mem

                   RETURN nAddr

          PROCEDURE CallDllFunction(strExport as String, strDllName as String) as String

                   *Create a string of machine code that calls a function in a DLL. Parms should already be pushed

                   LOCAL nAddr as Integer, hModule as Integer

                   hModule = LoadLibrary(strDllName)

                   INSERT INTO memAllocs VALUES (hModule,"L")    && track loads for freeing later

                   nAddr=GetProcAddress(hModule,strExport)

                   ASSERT nAddr != 0 MESSAGE "Error: Export not found "+ strExport+" "+ strDllName

                   RETURN CHR(0xb8)+BINTOC(nAddr,"4rs") + CHR(0xff) + CHR(0xd0)    && mov eax, addr; call eax

          PROCEDURE MakeStr(str as String, fConvertToUnicode as Logical, fMakeBstr as Logical) as Integer

                   * converts a string into a memory allocation and returns a pointer

                   LOCAL nRetval as Integer

                   IF fConvertToUnicode

                             str=STRCONV(str+CHR(0),5)

                   ELSE

                             str = str + CHR(0)    && null terminate

                   ENDIF

                   IF fMakeBstr

                             nRetval= SysAllocString(str)

                             ASSERT nRetval != 0 MESSAGE "Out of memory"

                             INSERT INTO memAllocs VALUES (nRetval,"B")     && track them for freeing later

                   ELSE

                             nRetval= this.MemAlloc(LEN(str),str)

                   ENDIF

                   RETURN nRetval

          PROCEDURE Destroy

                   LOCAL i

                   SELECT memAllocs

                   SCAN

                             DO CASE

                             CASE AllocType="B"  && BSTR

                                      SysFreeString(memPtr)

                             CASE AllocType="H"  && Heap

                                      HeapFree(this.hProcHeap,0,memPtr)

                             CASE AllocType="L"  && LoadLibrary

                                      FreeLibrary(memPtr)

                             ENDCASE

                   ENDSCAN

ENDDEFINE

 

DEFINE CLASS myclass AS custom

*        IMPLEMENTS RecordsetEvents IN "c:\Program Files\Common Files\System\Ado\msado15.dll"

          IMPLEMENTS RecordsetEvents IN "adodb.recordset"

          PROCEDURE Recordsetevents_WillChangeField(cFields AS Number @, Fields AS VARIANT @, adStatus AS VARIANT @, pRecordset AS VARIANT @) AS VARIANT

             ? " "+program() + ' ' + TRANSFORM(DATETIME())

 

          PROCEDURE Recordsetevents_FieldChangeComplete(cFields AS Number @, Fields AS VARIANT @, pError AS VARIANT @, adStatus AS VARIANT @, pRecordset AS VARIANT @) AS VARIANT

             ? " "+program() + ' ' + TRANSFORM(DATETIME())

 

          PROCEDURE Recordsetevents_WillChangeRecord(adReason AS VARIANT @, cRecords AS Number @, adStatus AS VARIANT @, pRecordset AS VARIANT @) AS VARIANT

             ? " "+program() + ' ' + TRANSFORM(DATETIME())

 

          PROCEDURE Recordsetevents_RecordChangeComplete(adReason AS VARIANT @, cRecords AS Number @, pError AS VARIANT @, adStatus AS VARIANT @, pRecordset AS VARIANT @) AS VARIANT

             ? " "+program() + ' ' + TRANSFORM(DATETIME())

 

          PROCEDURE Recordsetevents_WillChangeRecordset(adReason AS VARIANT @, adStatus AS VARIANT @, pRecordset AS VARIANT @) AS VARIANT

             ? " "+program() + ' ' + TRANSFORM(DATETIME())

             ?adreason,adstatus,precordset.recordcount

 

          PROCEDURE Recordsetevents_RecordsetChangeComplete(adReason AS VARIANT @, pError AS VARIANT @, adStatus AS VARIANT @, pRecordset AS VARIANT @) AS VARIANT

          ? " "+program() + ' ' + TRANSFORM(DATETIME())

 

          PROCEDURE Recordsetevents_WillMove(adReason AS VARIANT @, adStatus AS VARIANT @, pRecordset AS VARIANT @) AS VARIANT

             ? " "+program() + ' ' + TRANSFORM(DATETIME())

 

          PROCEDURE Recordsetevents_MoveComplete(adReason AS VARIANT @, pError AS VARIANT @, adStatus AS VARIANT @, pRecordset AS VARIANT @) AS VARIANT

             ? " "+program() + ' ' + TRANSFORM(DATETIME())

 

          PROCEDURE Recordsetevents_EndOfRecordset(fMoreData AS LOGICAL @, adStatus AS VARIANT @, pRecordset AS VARIANT @) AS VARIANT

             ? " "+program() + ' ' + TRANSFORM(DATETIME())

 

          PROCEDURE Recordsetevents_FetchProgress(Progress AS Number @, MaxProgress AS Number @, adStatus AS VARIANT @, pRecordset AS VARIANT @) AS VARIANT

             ? " "+program() + ' ' + TRANSFORM(DATETIME())

 

          PROCEDURE Recordsetevents_FetchComplete(pError AS VARIANT @, adStatus AS VARIANT @, pRecordset AS VARIANT @) AS VARIANT

             ? " "+program() + ' ' + TRANSFORM(DATETIME())

ENDDEFINE

 

*edited to add Craig's suggestion