Microsoft Visual FoxPro and Advanced COM 

 

Calvin Hsia
Microsoft Corporation

Created: April 2001

Revised: September 2001

Applies to:
     Microsoft® Visual FoxPro® 7.0

Summary: This article explains how to take advantage of the COM features in Microsoft Visual FoxPro by implementing interfaces and event binding. Earlier versions of Visual FoxPro provided early binding support for COM servers, but only late binding support as a client. This version of Visual FoxPro adds support for early binding clients. This paper discusses the inner workings of early versus late binding for both client and server. In addition, it discusses COM performance and how to make COM objects more discoverable. (27 printed pages)

Contents

Introduction
Creating a Simple Visual FoxPro COM Server
Type Libraries
Performance
Using Visual Basic as a Client
Error Handling
Interfaces
Event Binding
Using Office XP Smart Tags
Visual FoxPro Callback Design

Introduction

COM was developed to enable applications to be treated as objects, which have the ability to call each other. Object relationships can take on many forms. The simplest form is a client object, which calls a server object. Examples of more complex object interactions include peer-to-peer objects, which call each other.

If the objects have no prior knowledge of each other, then they need to be able to describe how another object can call into itself. Event interfaces are examples of objects that describe these callback interfaces. Event interfaces are not implemented by the software object developer but are implemented by a client of that object. Microsoft® ActiveX® controls provide an example of COM objects with very sophisticated interfaces. Located on both the control and the host, these interfaces make it possible for the control to act as a native control on a host site, which can implement the control's events interface. This combination can be very powerful in the hands of the developer.

This white paper begins with a simple explanation of the extreme usefulness of the Microsoft® Visual FoxPro® COM server. Next, it covers Type Libraries and how you can read them to discover how a COM object exposes itself to the world, as well as performance and error handling. Finally, the paper discusses interfaces and how to implement them.

Once you can implement interfaces, your capabilities open up to a new world of event binding, custom add-ins, and software architectures.

Another dimension to this discussion involves how objects call each other. Visual FoxPro 6.0 made it possible for both early and late binding clients to call Visual FoxPro 6.0 servers, but Visual FoxPro 6.0 only could call servers using late binding. The current version of Visual FoxPro includes the capability of early binding client calls.

Creating a Simple Visual FoxPro COM Server

To create a PRG file, to be called MYCLASS.PRG, use the following code:

*This entirely self-contained program will build a COM server 
* called "myserver.myclass"
* It will unregister a prior instance, if any
IF PROGRAM() != "MYCLASS"
   ?"this file MUST BE NAMED 'myclass.prg'"
   return
ENDIF
IF FILE("myclass.dll")
   DECLARE integer DllUnregisterServer IN myclass.dll
   DllUnregisterServer()
   CLEAR DLLS
ENDIF
BUILD PROJECT myserver FROM myclass
BUILD DLL myserver from myserver recomp
*now test this COM server:
ox = CreateObject("myserver.myclass")    && create the server object
ox.mydocmd("USE home(1)+'samples\data\customer'")    && use a table
?ox.myeval("RECCOUNT()")    && get the record count

DEFINE CLASS myclass AS session OLEPUBLIC
   PROCEDURE MyDoCmd(cCmd as String) as Variant ;
         helpstring "Execute a VFP cmd"
      &cCmd    && just execute parm as if it were a fox command
   FUNCTION MyEval(cExpr as String) ;
         helpstring "Evaluate a VFP expression"
      RETURN &cExpr    && evaluate parm as if it were a fox expr
   FUNCTION Error(nError, cMethod, nLine)
      COMreturnerror(cMethod+'  err#='+str(nError,5)+;
         '  line='+str(nline,6)+' '+message(),_VFP.ServerName)
      && this line is never executed
ENDDEFINE

A program of this structure will build COM servers and not pollute the registry. Note that the code before the class definition is executed at build time only. Building a COM server automatically registers it in the registry. Rebuilding the server automatically unregisters it first. However, the information to unregister is stored in the PJX file. If the PJX is deleted and rebuilt, then the registry entries are not removed when a new PJX is built.

Now, you have built your first server. Building a server in Visual FoxPro also builds a Type Library and registers information in the system registry including the ProgId, Type Library, and file location. The build process creates a file called myserver.vbr, which shows what registry keys get changed for registering the server correctly.

Notice that you are using the SESSION base class that was new to Visual FoxPro 6.0 SP3. It is a very lightweight base class that is non-visual and only has the DataSession property to make it possible for separate data sessions. When building COM servers, the FORM base class also has a DataSession property, but it also has many other properties that are irrelevant to a COM server. In addition, these properties are, by default, written out to the Type Library unless you mark them all as protected or hidden.

Type Libraries

A Type Library is a file that can be either freestanding or embedded as a resource inside an EXE or DLL. This language-independent method of publishing the interfaces, properties, and methods of a COM object can contain help strings, Help context IDs, parameter names, and member names (of properties and methods). If the Type Library it is not embedded inside an EXE or DLL, typical file extensions are TLB or OLB.

The Visual FoxPro 6.0 generated Type Libraries contain the method and parameter names of OLE Public methods. If there is a description in the Description of the class in the VCX, then that description is put in the Type Library as a help string.

You can view a Type Library using a variety of tools. For example, use the Object Browser in Microsoft® Excel or Microsoft Word, the Class Browser in Visual FoxPro, or the OLE Viewer in Microsoft Visual C++® to view a Type Library. You can see that Type Libraries can contain entire object models of the server application and can be rather extensive.

When some tool is viewing a Type Library, be aware that the server cannot be rebuilt, because the Type Library cannot be rewritten. Also, if a client has the server instantiated, it cannot be rebuilt. Using a copy of the built DLL or EXE is one way to avoid this problem.

Reading a Type Library

A Type Library reading tool (TLBINF32.DLL) ships with Microsoft Visual Studio®. TLBINF32.DLL is intended for use by multiple products, so it was written as a COM server. Here is some sample code to read the Type Library from the sample server created earlier.

clear
PUBLIC otlb
otli=NEWOBJECT('tli.tliapplication')
otlb=otli.TypeLibInfoFromFile("myserver.dll")
*otlb=otli.TypeLibInfoFromFile("tlbinf32.dll")
*otlb=otli.TypeLibInfoFromFile("c:\program files\microsoft 
         office\office\excel9.olb")
?"CoClasses:"
FOR each oCoClass in otlb.CoClasses
   ?"  ",oCoClass.name
   *now each interface associated with this CoClass
   for each oInterface in oCoClass.Interfaces
      ?"     ",oInterface.name
   endfor
endfor

?
?"Interfaces"

FOR each oInterface in otlb.Interfaces
   ?"  ",oInterface.name
ENDFOR 
?
?"Interface Members for 1st interface"
FOR each oMember IN otlb.Interfaces(1).Members
   ?"  ", oMember.name
   FOR each oParm in oMember.Parameters
      ?"             ",oParm.name
   ENDFOR
ENDFOR

This code first creates an instance of the TLB reading tool and then invokes the TypeLibInfoFromFile method to load a Type Library. Items within the library are represented as various collections, which can be manipulated quite easily in Visual FoxPro using the FOR EACH construct.

The Interface collection is a collection of interfaces described in the Type Library. These interfaces can be implemented either by the server or a client, for example, in the case of Events.

The CoClass collection describes the COM objects that can be created by a client. The default interface implemented by the CoClass is shown, along with an optional Event Source interface.

Other interfaces besides the default of the CoClass and the Event interface could be described. The way a client obtains these other interfaces could be through a method call. For example, an ICell interface could be returned from a method called GetCell.

Constants also can be defined in the Type Library. For example, to obtain the constants such as xlMaximized from the Excel Type Library, explore the otlb.Constants collection.

One way to learn how to use the TLBINF32.DLL tool is to use it on itself. This will show you the properties, methods, parameters, and so on that are useful in using this tool.

Performance

Performance means many things to many people. In the context of software and COM objects, performance means getting results faster. COM is about making software modules communicate with one another, so improving COM communications will achieve higher performance.

For example, consider the following code:

ox=CreateObject("excel.application")
start = seconds()
ox.workbooks.add
SET EXCLUSIVE OFF
USE HOME()+'samples\data\customer'
ox.visible=1
FOR i= 1 TO RECCOUNT()
   FOR J = 1 TO FCOUNT()
      ox.Activesheet.cells(i,j).value = EVAL(FIELD(j))
   NEXT
   SKIP
NEXT
ox.Workbooks(1).Close(0)   && close workbook, discarding changes
ox=0   && release Excel
?seconds() - start

The code fills an Excel spreadsheet with the values from a table; it takes about 30 seconds to run for 92 records on the author's machine.

When trying to improve performance, it is imperative to keep in mind exactly what is happening and try to figure out where the bottlenecks are located.

Making the spreadsheet visible only after it has been filled in, rather than beforehand, shaves off some time. Making Excel not maximized makes it run a little faster.

Note that most of the time is spent executing the single line of code that assigns the cell a value. You can remove all COM calls by changing this line to

      oa= EVAL(FIELD(j))

This obviously changes the intent of the code but makes the double loop take only one second. This indicates that 29 seconds was being spent in evaluating the ox.Activesheet.cells part of the line.

Analyzing this line further, Visual FoxPro evaluates ox.Activesheet, and the result is put in a temporary value. Then, this temp value is dereferenced to get the cells collection. Each "." in the expression results in a temporary value being obtained and then dereferenced to get a new value.

Each of these "." dot operator dereferences is actually a round-trip COM method call to Excel, invoking an Excel method which returns a value. First, the IApplication.ActiveSheet method is invoked, which returns to Visual FoxPro a temporary reference to the active sheet. Then, that object's interface is used to get the cells collection. Then, the collection is dereferenced using the cell's indices as parameters to get an object reference to a single cell. Then, that cell's value property is assigned a new value (another COM round-trip). This totals four round-trips.

Obtaining an object reference to ox.Activesheet before the double nested loop and using that cached reference instead resulted in about 50 percent improvement.

oa = ox.Activesheet    && get an object reference
FOR i= 1 TO RECCOUNT()
   FOR J = 1 TO FCOUNT()
      oa.cells(i,j).value = EVAL(FIELD(j))
   NEXT
   SKIP
NEXT

Because the Activesheet is loop invariant with respect to the double loop, you can obtain an object reference to it before the loop and cache it in a variable. This removes one round trip, thus making the total three.

The number of round-trips decreased by 25 percent, but the time decrease was 50 percent. The removal of the number of round-trips will not result in a proportional decrease in overall time. The overhead of creating and releasing several temporary variables, the fraction of the time spent actually in the server executing the code, and other factors are not linear.

Note   The previous code does not have to use Activesheet at all. The cells collection also is found from the Iapplication interface and was used here only for illustration purposes.

Using Visual Basic as a Client

You can use Visual Basic as a client to accomplish the same task.

To use Visual Basic as a client

  1. Start Excel.
  2. Choose Tools, choose Macro, choose Macros, and name it t.
  3. Choose Create.
  4. Choose Tools, choose References, and add the myserver Type Library to the references.

    This makes it possible for the myserver Type Library information to be used in the macro.

  5. Paste the following code:
    Sub t()
    Dim ox As New myserver.myclass
    ox.mydocmd ("set exclusive off")
    ox.mydocmd ("use d:\fox70\test\customer")
    n = ox.MyEval("reccount()")
    nflds = ox.MyEval("fcount()")
    nsecs = ox.MyEval("seconds()")
    For i = 1 To n
        For j = 1 To nflds
            cc = "evaluate(field(" & j & "))"
            Application.Sheets(1).Cells(i, j).Value = ox.MyEval(cc)
        Next
        ox.mydocmd ("skip")
    Next
    MsgBox (ox.MyEval("seconds()") - nsecs)
    End Sub
    

Error Handling

Servers that try to show UI make up one a very big reason why Error handling is so important in COM servers, and particularly so in DLL servers. If the client were to invoke a method on the server that caused some sort of error, such as File Not Found or Access Denied, it would not be good to have the server just show a message box indicating the error. The developer should use the Error Method of the OLE Public class to handle such errors gracefully. A new function in Visual FoxPro 6.0, called COMReturnError, will cause a COM Error object to be created and returned to the COM client. It takes two parameters: the Source and the Description. You can put any strings you want into these parameters. This example method can be pasted right into the previous myserver sample.

FUNCTION Error(nError, cMethod, nLine)
   COMreturnerror(cMethod+'  err#='+str(nError,5)+'  line='+str(nline,6)+'
      '+message(),_VFP.ServerName)
   && this line is never executed

You can invoke this error method by calling the MyDocmd method with an invalid command:

ox = CreateObject("myserver.myclass")    && create the server object
?ox.mydocmd("illegal command")    && causes an Error to occur

The error that occurs in the server is trapped by the MyClass::Error method, which then causes the server to abort processing and return the COM Error object with the Source and the Description filled out.

?aerror(myarray)
list memo like myarray
MYARRAY     Pub    A  
   (   1,   1)     N  1429        (      1429.00000000)
   (   1,   2)     C  "OLE IDispatch exception code 0 from mydocmd  
                      err#=   16  line=     2 Unrecognized command v
                      erb.: c:\fox\test\myserver.exe.."
   (   1,   3)     C  "c:\fox\test\myserver.exe"
   (   1,   4)     C  "mydocmd  err#=   16  line=     2 Unrecognized
                       command verb."
   (   1,   5)     C  ""
   (   1,   6)     N  0           (         0.00000000)
   (   1,   7)     N  0           (         0.00000000)

Interfaces

Operationally, a COM interface can be thought of as a pointer to a table of function addresses. This table is sometimes called the vtable, or virtual function table. The interface definition includes the number of entries in the table, the association between the method name and the table index, and the function signatures of each method call. The signature consists of the number of parameters, the types of the parameters, and the return value.

All COM interfaces inherit from IUnknown. This means that the first three entries in every COM interface vtable are defined to be the addresses of the server's implementation of IUnkown::QueryInterface, IUnkown::AddRef, and IUnkown::Release.

When an interface inherits from another interface, the interface's vtable consists of the vtables of the inherited interfaces first.

Dual interfaces are COM Interfaces that inherit from the IDispatch interface. The IDispatch interface has only four methods: GetTypeInfoCount, GetTypeInfo, GetIDsOfNames, and Invoke. Thus, the first seven interfaces are well defined in an IDispatch interface and any other interface that inherits from IDispatch.

For Myserver.dll created earlier, the dual interface IMyClass would look like this:

   IMyClass
      QueryInterface(QI params)  (from IUnknown)
      Addref                     (from IUnknown)
      Release                    (from IUnknown)
      GetTypeInfoCount()         (from IDispatch)
      GetTypeInfo()              (from IDispatch)
      GetIDsOfNames()            (from IDispatch)
      Invoke()                   (from IDispatch)
      MyDoCmd(cCmd)              (from IMyClass)
      MyEval(cExpr)              (from IMyClass)

Suppose that the client wants to make a call to the Activesheet method of the dual interface IApplication on the server. The actual call can be made in two ways: early and late binding. Early binding is sometimes called VTtable binding because it means the client calls the server directly by finding the address of Activesheet in the vtable directly. This function address is an entry in the vtable and will be larger than seven. This function address index is hard-coded into the client call at client compile time and is known as early binding. If subsequent versions of the server were to change the vtable order, then early binding client calls would be erroneous.

Late binding calls go through the IDispatch interface. The client calls IDispatch::GetIDsOfNames with the string Activesheet to get the function ID of that function. (The client for subsequent calls can then cache this function ID.) The client then packages all the Activesheet parameters into a single DISPPARAMS structure, and the IDispatch::Invoke function is called with the function ID and the DISPPARAMS as parameters. The implementation of IDispatch::Invoke on the server side unpacks the DISPPARAMS structure, makes the actual call to Activesheet, gets the return value, and passes that back to the client.

Because late binding does not hard code the function index of method calls, clients do not have to know at compile time what the function index is for methods and still will work, even if a new version of the server rearranges the vtable order or changes the method signatures. However, the parameter packaging on the client side and the unpackaging on the server side adds execution time to the method calls that does not exist with early binding calls.

Implementing Interfaces

What does it mean to implement an interface? It means that you examine an object's properties, events, and methods and create a new object that has exactly the same properties, events, and methods. This includes any parameters, parameter types, and return values. In other words, if an object knows how to call another object using a specific interface, then it also knows how to call any object that implements that specific interface.

Implementing an interface promises to the client that every method on that interface can be called. That means if there is a method called Foo(parm1 as int, parm2 as string, parm3 as variant @) as int, then that identical method signature must be found in the object.

In the following ADO sample, for example, if a parameter is removed from the method signature, running the code yields this message:

Class can not be instantiated because Member 'RECORDSETEVENTS_WillChangeField' has wrong # of parameters

Similarly, removing a method yields another error message.

As mentioned earlier, interfaces are described in Type Libraries for all to see. The Visual FoxPro 7.0 Object Browser (on the Tools menu) enables you to inspect type libraries. If you drag an interface from it onto a PRG that is open in the Visual FoxPro editor, then the object browser will generate the method signatures required for implementing that interface.

Event Binding

The ability to implement interfaces makes it possible for some interesting capabilities with Microsoft® Office. This sample implements the events for Microsoft® Outlook®, Excel, and Word. As you can see from the method names, each Office application provides different interfaces. The new EventBinding command in the current version of Visual FoxPro makes it possible for the developer to bind a Visual FoxPro class that implements an interface to the COM object that is the event source and publisher.

This event model is called tightly coupled events. The client and the server must have intimate knowledge of each other, and there is a one-to-one correspondence between the objects. A new model of object event interaction is called loosely coupled events, in which an object can publish events, and another object can subscribe to those events.

CLEAR
CLEAR all
PUBLIC ox as Excel.Application, ;
   ow as word.application, ;
   oOutlook as Outlook.Application

oOutlookEvents= NEWOBJECT('OutlookEvents')

oOutlook = NEWOBJECT("Outlook.Application")
oOutlookEvents.oo = oOutlook
? "Outlook",EVENTHANDLER( oOutlook, oOutlookEvents)

oWordEvents = NEWOBJECT("WordEvents")
ow = NEWOBJECT("word.application")
oWordEvents.ow = ow
?"Word",EVENTHANDLER(ow,oWordEvents)
ow.visible = .t.
ow.Activate
ow.Documents.Add

oExcelEvents = NEWOBJECT("ExcelEvents")
oex = NEWOBJECT("excel.application")
oex.Workbooks.Add
?"Excel",EVENTHANDLER(oex, oExcelEvents)
oex.visible = .t.

_screen.WindowState= 1

DEFINE CLASS OutlookEvents AS SESSION OLEPUBLIC
   IMPLEMENTS ApplicationEvents IN Outlook.Application
   oo = .null.
   PROCEDURE ApplicationEvents_ItemSend(ITEM AS VARIANT, ;
         CANCEL AS LOGICAL) AS VOID
      ?PROGRAM()
      m.item.Body=STRTRAN(m.item.Body,"good","bad") + ;
         CHR(13)+CHR(10)+TRANSFORM(DATETIME())+" Fox was here!"
*      if Recipients fails, it could be outlook security
*      m.item.Recipients.Add("anyone@anywhere.com")
   PROCEDURE ApplicationEvents_NewMail() AS VOID
      ?PROGRAM()
   PROCEDURE ApplicationEvents_Reminder(ITEM AS VARIANT) AS VOID
      ?PROGRAM()
   PROCEDURE ApplicationEvents_OptionsPagesAdd(PAGES AS VARIANT) AS VOID
      ?PROGRAM()
   PROCEDURE ApplicationEvents_Startup() AS VOID
      ?PROGRAM()
   PROCEDURE ApplicationEvents_Quit() AS VOID
      ?PROGRAM()
   PROCEDURE destroy
      ?PROGRAM()
      IF !ISNULL(this.oo)
         ?EVENTHANDLER(this.oo,this,.t.)
      ENDIF
ENDDEFINE

DEFINE CLASS WordEvents as Custom
   implements applicationevents2 in "word.application"
   ow = .null.
   PROCEDURE applicationevents2_startup()
      ?PROGRAM()
   PROCEDURE applicationevents2_quit
      ?PROGRAM()
   procedure applicationevents2_DocumentBeforeClose(Cancel,Doc)
      ?PROGRAM()
   procedure DocumentBeforeClose(Cancel,Doc)
      ?PROGRAM()
   procedure applicationevents2_DocumentBeforePrint(Cancel,Doc)
      ?PROGRAM()
   procedure applicationevents2_DocumentBeforeSave(Doc,SaveAsUI,Cancel)
      ?PROGRAM()
   procedure applicationevents2_DocumentChange
      ?PROGRAM()
   procedure applicationevents2_DocumentOpen(Doc)
      ?PROGRAM()
   procedure applicationevents2_NewDocument(Doc)
      ?PROGRAM()
   procedure applicationevents2_WindowActivate(Doc,Wn)
      ?PROGRAM()
   procedure applicationevents2_WindowBeforeDoubleClick(Sel,Cancel)
      ?PROGRAM()
   procedure applicationevents2_WindowBeforeRightClick(Sel,Cancel)
      ?PROGRAM()
   procedure applicationevents2_WindowDeactivate(Doc,Wn)
      ?PROGRAM()
   procedure applicationevents2_WindowSelectionChange(Sel)
      ?PROGRAM(),sel.text
      IF sel.start < sel.end
          sel.InsertAfter("Fox!")
*!*         mtmp = sel.text
*!*         sel.text=STRTRAN(mtmp,"good","Great!")
      endif
   PROCEDURE destroy
       ?PROGRAM()
       IF !ISNULL(this.ow)
         ?EVENTHANDLER(this.ow,this,.t.)
      ENDIF
ENDDEFINE

DEFINE CLASS ExcelEvents AS session OLEPUBLIC
   IMPLEMENTS AppEvents IN "excel.application"
   PROCEDURE AppEvents_NewWorkbook(Wb AS VARIANT) AS VOID
      ?PROGRAM()
   PROCEDURE AppEvents_SheetSelectionChange(Sh AS VARIANT, ;
         Target AS VARIANT) AS VOID
      LOCAL mtmp,mcell
      mcell = m.target.Cells(1,1)
      IF !ISNULL(mcell)
         mtmp = m.target.Cells(1,1).Value
         ?PROGRAM(),VARTYPE(mtmp)
         DO case
         case ISNULL(mtmp)
   *         m.target.Cells(1,1).Value  = "Fox is great"
         CASE VARTYPE(mtmp)='C'
            m.target.Cells(1,1).Value = ;
               STRTRAN(mtmp,"good","great!")
         CASE VARTYPE(mtmp)='N'
            m.target.Cells(1,1).Value = mtmp + 1
         ENDCASE
      ENDIF
   PROCEDURE AppEvents_SheetBeforeDoubleClick(Sh AS VARIANT, ;
         Target AS VARIANT, Cancel AS LOGICAL) AS VOID
      ?PROGRAM()
   PROCEDURE AppEvents_SheetBeforeRightClick(Sh AS VARIANT, ;
         Target AS VARIANT, Cancel AS LOGICAL) AS VOID
      ?PROGRAM()
   PROCEDURE AppEvents_SheetActivate(Sh AS VARIANT) AS VOID
      ?PROGRAM()
   PROCEDURE AppEvents_SheetDeactivate(Sh AS VARIANT) AS VOID
      ?PROGRAM()
   PROCEDURE AppEvents_SheetCalculate(Sh AS VARIANT) AS VOID
      ?PROGRAM()
   PROCEDURE AppEvents_SheetChange(Sh AS VARIANT, Target AS VARIANT) AS
         VOID
      ?PROGRAM()
   PROCEDURE AppEvents_WorkbookOpen(Wb AS VARIANT) AS VOID
      ?PROGRAM()
   PROCEDURE AppEvents_WorkbookActivate(Wb AS VARIANT) AS VOID
      ?PROGRAM()
   PROCEDURE AppEvents_WorkbookDeactivate(Wb AS VARIANT) AS VOID
      ?PROGRAM()
   PROCEDURE AppEvents_WorkbookBeforeClose(Wb AS VARIANT, ;
         Cancel AS LOGICAL) AS VOID
      ?PROGRAM()
   PROCEDURE AppEvents_WorkbookBeforeSave(Wb AS VARIANT, ;
         SaveAsUI AS LOGICAL, Cancel AS LOGICAL) AS VOID
      ?PROGRAM()
   PROCEDURE AppEvents_WorkbookBeforePrint(Wb AS VARIANT, ;
         Cancel AS LOGICAL) AS VOID
      ?PROGRAM()
   PROCEDURE AppEvents_WorkbookNewSheet(Wb AS VARIANT, ;
         Sh AS VARIANT) AS VOID
      ?PROGRAM()
   PROCEDURE AppEvents_WorkbookAddinInstall(Wb AS VARIANT) AS VOID
      ?PROGRAM()
   PROCEDURE AppEvents_WorkbookAddinUninstall(Wb AS VARIANT) AS VOID
      ?PROGRAM()
   PROCEDURE AppEvents_WindowResize(Wb AS VARIANT, Wn AS VARIANT) AS VOID
      ?PROGRAM()
   PROCEDURE AppEvents_WindowActivate(Wb AS VARIANT, Wn AS VARIANT) AS
         VOID
      ?PROGRAM()
   PROCEDURE AppEvents_WindowDeactivate(Wb AS VARIANT, Wn AS VARIANT) AS
         VOID
      ?PROGRAM()
   PROCEDURE AppEvents_SheetFollowHyperlink(Sh AS VARIANT, ;
         Target AS VARIANT) AS VOID
      ?PROGRAM()
   PROCEDURE AppEvents_SheetPivotTableUpdate(Sh AS VARIANT, ;
         Target AS VARIANT) AS VOID
      ?PROGRAM()
   PROCEDURE AppEvents_WorkbookPivotTableCloseConnection(Sh AS VARIANT, ;
         Target AS VARIANT) AS VOID
      ?PROGRAM()
   PROCEDURE AppEvents_WorkbookPivotTableOpenConnection(Sh AS VARIANT, ;
         Target AS VARIANT) AS VOID
      ?PROGRAM()
ENDDEFINE

The following is a sample of implementing ADO event interfaces. In this case, the user is not interacting with an application, causing events to occur as in the Office examples earlier. Here, the user is calling ADO directly using method calls, and ADO is calling back to the client using its event interface.

clear
CLEAR all
local ox as adodb.recordset
local oc as ADODB.Connection
oe = NEWOBJECT("myclass")
oe2 = NEWOBJECT("myclass")

oc=NEWOBJECT("adodb.connection")
connstr = "Driver={Microsoft Visual FoxPro Driver};UID=;PWD=;SourceDB=" + ;
   HOME(1)+"samples\data\testdata.dbc" + ;
    ";SourceType=DBC;Exclusive=No;BackgroundFetch=No;Collate=Machine;"
*
oc.ConnectionString= connstr
oc.Open
ox = oc.Execute("select * from customer")
* Now enable event handling
?EVENTHANDLER(ox,oe)
?EVENTHANDLER(ox,oe2)

?
?PADR(ox.Fields(0).Value,20)

?EVENTHANDLER(ox,oe2,.f.) && Turn off 2nd obj event handling 
ox.MoveNext
?PADR(ox.Fields(0).Value,20)
ox.MoveNext
CLEAR all
retu
for i = 0 to ox.Fields.Count-1
*   ?PADR(ox.Fields(i).Name,20)
*   ?ox.Fields[i].value
endfor

DEFINE CLASS myclass AS session
   implements RecordsetEvents IN "adodb.recordset"
*  implements RecordsetEvents IN ;
*"C:\PROGRAM FILES\COMMON FILES\SYSTEM\ADO\MSADO15.DLL"
   PROCEDURE Recordsetevents_WillChangeField(cFields AS Number @, ;
         Fields AS VARIANT @, adStatus AS VARIANT @, ;
         pRecordset AS VARIANT @) AS Void
      ? " "+program() + ' ' + TRANSFORM(DATETIME())
   PROCEDURE Recordsetevents_FieldChangeComplete(;
         cFields AS Number @, ;
         Fields AS VARIANT @, pError AS VARIANT @, ;
         adStatus AS VARIANT @, pRecordset AS VARIANT @) AS Void
      ? " "+program() + ' ' + TRANSFORM(DATETIME())
   PROCEDURE Recordsetevents_WillChangeRecord(adReason AS VARIANT @, ;
         cRecords AS Number @, adStatus AS VARIANT @, ;
         pRecordset AS VARIANT @) AS Void
      ? " "+program() + ' ' + TRANSFORM(DATETIME())
   PROCEDURE Recordsetevents_RecordChangeComplete(adReason AS VARIANT @, ;
         cRecords AS Number @, pError AS VARIANT @, ;
         adStatus AS VARIANT @, pRecordset AS VARIANT @) AS Void
      ? " "+program() + ' ' + TRANSFORM(DATETIME())
   PROCEDURE Recordsetevents_WillChangeRecordset(adReason AS VARIANT @, ;
         adStatus AS VARIANT @, pRecordset AS VARIANT @) AS Void
      ? " "+program() + ' ' + TRANSFORM(DATETIME())
      ?adreason,adstatus,precordset.recordcount
   PROCEDURE Recordsetevents_RecordsetChangeComplete(;
         adReason AS VARIANT @, ;
         pError AS VARIANT @, adStatus AS VARIANT @, ;
         pRecordset AS VARIANT @) AS Void
      ? " "+program() + ' ' + TRANSFORM(DATETIME())
   PROCEDURE Recordsetevents_WillMove(adReason AS VARIANT @, ;
         adStatus AS VARIANT @, pRecordset AS VARIANT @) AS Void
      ? " "+program() + ' ' + TRANSFORM(DATETIME())
   PROCEDURE Recordsetevents_MoveComplete(adReason AS VARIANT @, ;
         pError AS VARIANT @, adStatus AS VARIANT @, ;
         pRecordset AS VARIANT @) AS Void
      ? " "+program() + ' ' + TRANSFORM(DATETIME())
   PROCEDURE Recordsetevents_EndOfRecordset(fMoreData AS LOGICAL @, ;
         adStatus AS VARIANT @, pRecordset AS VARIANT @) AS Void
      ? " "+program() + ' ' + TRANSFORM(DATETIME())
   PROCEDURE Recordsetevents_FetchProgress(Progress AS Number @, ;
         MaxProgress AS Number @, adStatus AS VARIANT @, ;
         pRecordset AS VARIANT @) AS Void
      ? " "+program() + ' ' + TRANSFORM(DATETIME())
   PROCEDURE Recordsetevents_FetchComplete(pError AS VARIANT @, ;
         adStatus AS VARIANT @, pRecordset AS VARIANT @) AS void
      ? " "+program() + ' ' + TRANSFORM(DATETIME())
ENDDEFINE

Using Office XP Smart Tags

Office XP includes a new capability called Smart Tags. As a typical knowledge worker at a company works, she might use several computer applications and use similar subjects in each one. For example, the company might have a customer list, and she might need to e-mail, create documents or spreadsheets, or even view Web pages about customers. Suppose that at this instant, she is writing e-mail about customer ALFKI, and she must know the customer phone number or credit limit. Typically, this means starting or switching to another application that maintains this information, doing a lookup for ALFKI, and then transferring the data to the e-mail.

Smart Tags technology is a way that multiple applications can recognize strings (tags) within text and optionally provide the user a way to invoke a menu right on top of that tag which can give useful information or perform useful tasks. A smart tag on ALFKI might not only offer the credit limit and address but also might offer the option to go to the customer's Web site, add to a transaction log, launch another application, or even dial the phone. The user could even type in ALFKI temporarily to any application that is being used currently, lookup information, then delete that string in the app.

The following is a sample of Smart Tags technology that recognizes the customer IDs in the sample customer table. The Smart Tag action verbs are the fields of the table, plus one to visit the customer Web site. If the application is Word, then the verb for the field will insert that field into the Word document. For Excel, the field value will be inserted in the adjacent column, and the width of that column is adjusted. For Internet Explorer, a message box is displayed (note that even though this is a Visual FoxPro DLL, MessageBox can be called using Declare DLL).

A Smart Tag only must register its ProgID in the registry at the appropriate places. The Smart Tag SDK (available on the Microsoft Web site) gives more details on Smart Tags.

A Smart Tag must implement two interfaces: ISmartTagRecognizer and ISmartTagAction. The first scans a string and calls back on a parsed object if a tag is recognized. The second interface describes the actions possible and actually performs the actions.

Note   Any open Office applications will have an instance of your DLL open; thus you will not be able to modify the DLL until you close down the Office application.

The Logit method writes to a log file, which is a useful technique to learn about how the interfaces work and to debug any code. Using an editor that automatically refreshes an externally modified file to display the log is useful.

CLEAR ALL
clear
SET excl off
?PROGRAM()

*Smart tags in Office XP. Just change the DATAPATH,STAGPATH if necessary
IF PROGRAM() != "STAG"
   ?"this file MUST BE NAMED 'stag.prg'"
ENDIF
#define STNAME  "MynameSpaceURI#MyLocalName"
#define DATAPATH HOME(1)+"samples\data\"
#define STAGPATH "C:\Program Files\Common Files\Microsoft Shared\Smart 
         Tag\mstag.tlb"
IF .t.
   IF FILE("stag.dll")
      DECLARE integer DllUnregisterServer IN stag.dll
      DllUnregisterServer()
      CLEAR DLLS
   ENDIF
   BUILD PROJECT stag FROM stag
   BUILD mtDLL stag from stag recomp
   STRTOFILE("","d:\t.txt")    && null log file
endif

#DEFINE HKEY_CURRENT_USER  -2147483647  && BITSET(0,31)+1
oFoxReg=NEWOBJECT("foxreg", HOME(1)+"FFC\registry")
oFoxReg.OpenKey("Software\Microsoft\Office\Common\Smart 
         Tag\Actions\stag.MyStag", ;
   HKEY_CURRENT_USER, .T.)
oFoxReg.OpenKey(;
   "Software\Microsoft\Office\Common\Smart Tag\Recognizers\stag.MyStag", ;
   HKEY_CURRENT_USER, .T.)

DEFINE CLASS MyStag AS Session OLEPUBLIC
   IMPLEMENTS ISmartTagRecognizer IN STAGPATH
   IMPLEMENTS ISmartTagAction IN STAGPATH
   PROCEDURE ISmartTagRecognizer_get_ProgId() AS STRING
      logit()
      RETURN   "stag.MyStag"
   PROCEDURE ISmartTagRecognizer_get_Name(LocaleID AS Integer) AS STRING
      logit()
      RETURN "VFP NorthWind Customer Recognizer"
   PROCEDURE ISmartTagRecognizer_get_Desc(LocaleID AS Integer) AS STRING
      logit()
      RETURN "VFP NorthWind Customer ID Recognizer"
   PROCEDURE ISmartTagRecognizer_get_SmartTagCount() AS Integer
      logit()
      RETURN 1
   PROCEDURE ISmartTagRecognizer_get_SmartTagName(;
         SmartTagID AS Integer) AS STRING
      logit()
      If SmartTagID = 1
         RETURN STNAME
         EndIf
      RETURN ""
   PROCEDURE ISmartTagRecognizer_get_SmartTagDownloadURL(;
         SmartTagID AS Integer) AS STRING
      logit()
      RETURN ""
   PROCEDURE ISmartTagRecognizer_Recognize(cText AS STRING, ;
         DataType AS Integer, ;
         LocaleID AS Integer, RecognizerSite AS VARIANT) AS VOID
      logit(ctext+' '+TRANSFORM(LEN(CTEXT)))
      LOCAL i,  mat,cWord,propbag
      i = 1
      DO WHILE i <= LEN(cText)
         IF ISALPHA(SUBSTR(cText,i))
            mst = i
            DO WHILE i <= LEN(cText) AND ;
                  (ISALPHA(SUBSTR(cText,i)) or ;
                  ISDIGIT(SUBSTR(cText,i)))
               i=i+1
            ENDDO
            IF mst # i
               cWord = SUBSTR(cText,mst,i-mst)
               IF SEEK(cWord,"Customer")
                  * Ask for a property bag
                  propbag = ;
                     RecognizerSite.GetNewPropertyBag()
                  * Commit the smart tag 
                  propbag.write("test","value")
                  propbag.write("test2","value2")
                     RecognizerSite.CommitSmartTag(STNAME, ;
                       mst, LEN(cWord), propbag)
                    propbag=.null.
               ENDIF
            ENDIF
         ENDIF
         i=i+1
      ENDDO
***********************
   PROCEDURE ISmartTagAction_get_ProgId() AS STRING
      logit()
      RETURN "stag.MyStag"
   PROCEDURE ISmartTagAction_get_Name(LocaleID AS Integer) AS STRING
      logit()
      RETURN "Customer Actions"
   PROCEDURE ISmartTagAction_get_Desc(LocaleID AS Integer) AS STRING
      logit()
      RETURN  "Provides actions for VFP Customer data"
   PROCEDURE ISmartTagAction_get_SmartTagCount() AS Integer
      logit()
      RETURN 1
   PROCEDURE ISmartTagAction_get_SmartTagName(SmartTagID AS Integer) AS
         STRING
      logit()
      IF SmartTagID = 1
         RETURN STNAME
      EndIf
      RETURN ""
   PROCEDURE ISmartTagAction_get_SmartTagCaption(SmartTagID AS Integer, ;
         LocaleID AS Integer) AS STRING
      logit(TRANSFORM(SmartTagID ))
      RETURN  "Customer Lookup"
   PROCEDURE ISmartTagAction_get_VerbCount(SmartTagName AS STRING) AS
         Integer
      logit(SmartTagName )
      If SmartTagName = STNAME
            RETURN FCOUNT()+1
         ENDIF
         RETURN 0
   PROCEDURE ISmartTagAction_get_VerbID(SmartTagName AS STRING, ;
         VerbIndex AS Integer) AS Integer
      logit(SmartTagName +', '+ TRANSFORM(VerbIndex ))
      RETURN VerbIndex
   PROCEDURE ISmartTagAction_get_VerbCaptionFromID(VerbID AS Integer, ;
         _ApplicationName AS STRING, LocaleID AS Integer) AS STRING
      logit(TRANSFORM(VerbID )+' '+_ApplicationName +;
         ' '+TRANSFORM(LocaleID))
      IF VerbId <= FCOUNT()
         RETURN "View "+FIELD(VerbID)
      ENDIF
      RETURN "Visit customer Web site"
   PROCEDURE ISmartTagAction_get_VerbNameFromID(VerbID AS Integer) AS
         STRING
      logit(TRANSFORM(VerbID))
      IF VerbId <= FCOUNT()
         RETURN FIELD(VerbID)
      ENDIF
      RETURN "Visit Web site"
   PROCEDURE ISmartTagAction_InvokeVerb(VerbID AS Integer, ;
         cApplicationName AS STRING, ;
         Target AS VARIANT, oProperties AS VARIANT, ;
         cText AS STRING, Xml AS STRING) AS VOID
      logit(TRANSFORM(VerbID )+' '+cApplicationName +' '+cText+' ';
          +Xml+' '+TRANSFORM(oProperties.count))
      LOCAL i,cProp
      oProperties.write("iitest","iivalue")
      oProperties.write("iitest2","iivalue2")
      FOR i = 1 to oProperties.count
         cProp = oProperties.keyfromindex(i-1)
         logit(cProp)
         logit(oProperties.read(cprop))
      endfor
      LOCAL fExcel,fWord
      DO case
      CASE capplicationname = "Excel.Application.10"
         fExcel = .t.
         logit(m.target.cells[1,1].value)
      CASE capplicationname = "Word.Application.10"
         fWord = .t.
*         logit(m.target.range
      ENDCASE
      IF verbId > FCOUNT()
         LOCAL oie as internetexplorer.application
         oie = NEWOBJECT("internetexplorer.application")
         oie.navigate2("localhost/"+ctext+".html")
         oie.visible=1
      else
         IF SEEK(cText,"customer")
            DO case
            case fExcel
               target.cells[1,2].value = ;

   ALLTRIM(TRANSFORM(EVALUATE(FIELD(VerbID))))
               target.Columns(2).columnWidth = 25
            case fWord
               target.insertAfter(' '+;

   ALLTRIM(TRANSFORM(EVALUATE(FIELD(VerbID)))))
            otherwise
               DECLARE Integer MessageBox IN WIN32API ;
                  as msgbox ;
                  Integer,string,string, integer
               msgbox(0,;

   ALLTRIM(TRANSFORM(EVALUATE(FIELD(VerbID)))), ;
                  ctext+"="+company,0)
            endcase
         ELSE
            logit("not found")
         ENDIF
      ENDIF
   PROCEDURE Init
      logit()
      SET EXACT ON
      SET EXCLUSIVE off
      SET PATH TO DATAPATH
      USE customer order cust_id shared
   PROCEDURE Destroy
      logit()
   PROCEDURE MyDoCmd(cCmd as String)
      &cCmd
   PROCEDURE MyEval(cExp as String)
      RETURN &cExp
   PROCEDURE Error(nError, cMethod, nLine)
      logit(TRANSFORM(nError)+' '+TRANSFORM(nLine)+' '+MESSAGE())
ENDDEFINE
#if .f.
DEFINE CLASS STagAction AS StagRecognizer OLEPUBLIC
   PROCEDURE Error(nError, cMethod, nLine)
      logit(PROGRAM()+" "+TRANSFORM(nError)+' '+TRANSFORM(nLine)+' 
            '+MESSAGE())

ENDDEFINE
#endif
   FUNCTION Logit(cStr)
TEXT TO mystr TEXTMERGE NOSHOW
<<DATETIME()>> <<PROGRAM(PROGRAM(-1)-1)>> <<cStr>>

ENDTEXT
      STRTOFILE(myStr,"D:\t.TXT",.T.)

Visual FoxPro Callback Design

Visual FoxPro 7.0 makes it possible for the developer to create COM objects, which publish interfaces that clients can implement. This callback scenario is almost identical to Visual FoxPro objects raising events to clients. This sample consists of a main COM server class called IDEMO, which also publishes an event interface called DemoEvents.

The client code has a single class called cCallBack, which implements DemoEvents.

IDEMO has a method called BuyStock, which clients can call to buy some stock. The BuyStock method just has a comment where code can be put to buy the stock. However, before and after that code, the method calls methods in the DemoEvents class. If the client does not have a callback procedure set using the SetCallBack method, then the calls to the DemoEvents methods do nothing. However, if there is a callback object, then those methods will be called on the client.

CLEAR ALL
IF PROGRAM() != "IDEMO"
   ?"this file MUST BE NAMED 'idemo.prg'"
   RETURN
ENDIF
IF .t.
   IF FILE("idemo.dll")
      DECLARE integer DllUnregisterServer IN idemo.dll
      DllUnregisterServer()
      CLEAR DLLS
   ENDIF
   BUILD PROJECT idemo FROM idemo
   BUILD DLL idemo from idemo recomp
endif
clear

oCallback = NEWOBJECT("cCallback")    && the event callback
ostock=newOBJECT("idemo.idemo")       && the business COM obj
ostock.setcallback(oCallBack)         && like BindEvents
?ostock.BuyStock("MSFT",10000 )       && invoke a method
ostock.setcallback(.null.)            && like UnBindEvents
?ostock.BuyStock("MSFT",20000 )       && this one doesn't fire events

*This is the actual implementation of the event interface
DEFINE CLASS cCallback as session
   implements iDemoEvents in idemo.dll
   procedure iDemoEvents_BeforeBuyStock(cStock as String, qty AS Number)
      ?program(),cstock,qty
   procedure iDemoEvents_AfterBuyStock(cStock as String, qty AS Number)
      ?program(),cstock,qty

enddefine
*the rest of this file is used in the COM server
DEFINE CLASS idemo as session olepublic
   oc = .null.
   PROCEDURE init
      this.SetCallBack(.null.)    && set callback to default
   PROCEDURE setcallback(oC as Variant)
      IF ISNULL(oc)
         && dummy instance that does nothing: virtual function
         this.oc = NEWOBJECT("DemoEvents")
      else
         IF VARTYPE(oc) != 'O'
            COMRETURNERROR(PROGRAM(),"callback must be obj")
         ENDIF
         this.oc = GETINTERFACE(oC,"iDemoEvents","idemo.idemo")
      endif
   procedure MyDoCmd(cCmd as String) as Variant
      &cCmd
   procedure MyEval(cExpr as String) as Variant
      return &cExpr
   procedure BuyStock(cStock as String, qty AS Number) as Boolean
      this.oc.BeforeBuyStock(cStock, qty)
      *here we buy the stock
      this.oc.AfterBuyStock(cStock, qty)
   FUNCTION Error(nError, cMethod, nLine)
      COMreturnerror(cMethod+'  err#='+str(nError,5)+'  line='+;
         str(nline,6)+' '+message(),_VFP.ServerName)
      && this line is never executed

enddefine

*Just an interface definition that should be implemented by outside callers
DEFINE CLASS DemoEvents as session olepublic
   procedure BeforeBuyStock(cStock as String, qty AS Number)
   procedure AfterBuyStock(cStock as String, qty AS Number)
enddefine

COM enables objects to interact with each other in various ways. Each addition of new COM capabilities to Visual FoxPro over the years, from a simple COM client functionality, interface implementation, and early binding server and client support, has opened whole new worlds of capability.

Show: