Calvin Hsia's WebLog

Strongly typed methods and properties

VFP allows you to generate COM servers using the OLEPUBLIC keyword. These objects can have custom properties. For example, a Customer object can have an Address property of type string.

Other client applications (VFP, Excel, VB.Net, VB Script) can see these properties/methods in intellisense (you may have to add a reference to the object’s Type Library, which is embedded into the VFP COM object).

There are times when you’d like a method or property to return a complex type, not just a string or number. A Customer might have a member called GetOrder which is of type “Order” which is another object within the same server.

Other examples of complex object hierarchies are:

• Excel has Workbooks which contain Worksheets
• VFP has Projects which contain Files which have members like “Name” or “Modify”
• An XMLDOM document can contain child nodes
• A treeview control can contain nodes

You can examine the Type Libraries of each of these using the object browser or OleView and see that members return types that are defined from elsewhere within the same Type Library.

Open a project in VFP and type this to see the intellisense show:

_vfp.ActiveProject.Files(1).Modify

VFP COM servers do not directly allow an object’s member to return a strongly typed complex type. Variant is the best you can do.

Why can’t VFP COM objects have members that return a type from within the same server?

The MIDL compiler can generate such complex Type Libraries. A text file describing the desired Type Library using Interface Definition Language (IDL) is used as input to MIDL, and the result is a Type Library. VFP does not ship with the MIDL compiler.

If you have the MIDL compiler (ships with Visual Studio), try to run the code below. Just paste it all into a single PRG file called TLIBTEST.PRG It builds a sample COM server with a Customer object that has members that return an Orders object, which is defined in the same server. It then tests the server by calling the GetOrder method with a dummy parameter value.

After the code is done, try this in the command window

ox.GetOrder("a").

You’ll notice that intellisense shows the properties of the “Order” object after the last “.” Or try running a VB .NET application as indicated in the comments.

The code builds a sample COM server project and uses a project hook class AfterBuild method to process the server’s Type Library after it has been created. It uses TLI.TLIApplication to scan through the VFP generated Type Library and generate IDL. The IDL is modified according to the helpstring found. If the helpstring contains a “|”, then the string after is interpreted as the new return type for that method or property. For a property, a helpstring can be specified using the COMATTRIB.

The code then calls MIDL to generate a new Type Library and uses the UpdateResource function to put the Type Library back into the server.

Thanks to Rick Strahl for helping to test this.

CLEAR ALL

CLEAR

IF JUSTFNAME(PROGRAM())!="TLIBTEST"

      ?"This sample file must be called TLIBTEST"

      RETURN

ENDIF

#if .f.

      This file must be named tlibtest.prg

      This sample shows how you can manipulate the TLB inside a VFP DLL.

      It will build a sample COM server with 2 OLEPUBLIC objects: customer, orders

      It allows you to return strongly typed custom types from methods. Customer.GetOrder() returns an Orders object, rather

      than just a VARIANT.

      It uses tli.tliapplication (REGSVR32 c:\windows\system32\tlbinf32.dll (shipped with various Visual Studio versions)

      to read the VFP generated typelib, and generates identical IDL.

      If there is a "|" character in the HELPSTRING for a Property/Method, it is interpreted as an instruction to substitute

      the rest of the helpstring as the type of that Property/Method.

      It runs MIDL to generate a new typelib, and some manipulation of the DLL to add the new Typelib.

      There's some test VFP code to make sure it still works as expected

Run these few lines of code in VB.Net 2003 (or C#. Add a reference to tlibtest.dll) and it just works.

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        Dim ocust As New tlibtest.CustomerClass

        Dim oord As tlibtest.OrdersClass

        oord = ocust.GetOrder("adsf")

        Me.Text = oord.ORDER_ID

    End Sub

      Notice that the sample code requires BeginUpdateResource (not available on Win9x (or NT? )) and MIDL,

      both of which VFP can't ship with, but which are shipped with VS.

      To use with your project, you only need the projecthook class, and modify your helpstrings to

      make strongly typed member types.

      (you may need to modify the path for VS.NET below: "c:\Program Files\Microsoft Visual Studio .NET 2003\Vc7\bin\vcvars32.bat")

#endif

SET SAFETY off

IF FILE("tlibtest.dll")

      DECLARE integer DllUnregisterServer IN tlibtest.dll

      ?"Unregister",DllUnregisterServer()

      CLEAR DLLS

ENDIF

IF !FILE("tlibtest.pjx")

      BUILD PROJECT tlibtest FROM tlibtest      && only once so doesn't pollute registry

ENDIF

MODIFY PROJECT tlibtest NOWAIT

_vfp.ActiveProject.ProjectHook = NEWOBJECT('myphook') && use projecthook to modify typelibrary if necessary

BUILD MTDLL tlibtest FROM tlibtest

_vfp.ActiveProject.Close

*Now test it

PUBLIC ox as tlibtest.Customer

ox=CREATEOBJECT("tlibtest.customer")

oord=ox.getorder("aa")

?"testing:",oord.order_id

oord=0

DEFINE CLASS MyPHook AS ProjectHook

      PROCEDURE GetType(oType as tli.VarTypeInfo) as String

            LOCAL cstr,nType

            nType=oType.VarType

            cstr=""

            IF oType.PointerLevel>0 AND !ISNULL(oType.TypeInfo)

                  cstr=cstr+oType.TypeInfo.Name+" *"

                  RETURN cstr

            ENDIF

            IF BITAND(nType,8192)>0

                  cstr="VT_ARRAY | "

                  nType=nType-8192

            ENDIF

            DO case

            CASE nType=0

                  cstr=cstr+ "VT_EMPTY"

            CASE nType=2

                  cstr=cstr+ "VT_I2"

            CASE nType=3

                  cstr=cstr+ "integer"

            CASE nType=7

                  cstr=cstr+ "DATE"

            CASE nType=8

                  cstr=cstr+ "BSTR"

            CASE nType=9

                  cstr=cstr+ "VT_DISPATCH"

            CASE nType=11

                  cstr=cstr+ "BOOL"

            CASE nType=12

                  cstr=cstr+ "VARIANT"

            CASE nType=13

                  cstr=cstr+ "VT_UNKNOWN"

            CASE nType=16

                  cstr=cstr+ "VT_I1"

            CASE nType=17

                  cstr=cstr+ "VT_UI1"

            CASE nType=18

                  cstr=cstr+ "VT_UI2"

            CASE nType=19

                  cstr=cstr+ "VT_UI4"

            CASE nType=22

                  cstr=cstr+ "VT_INT"

            CASE nType=23

                  cstr=cstr+ "VT_UINT"

            CASE nType=24

                  cstr=cstr+ "VOID"

            CASE nType=25

                  cstr=cstr+ "VT_HRESULT"

            OTHERWISE

                  SET STEP ON

            ENDCASE

      RETURN cstr

      PROCEDURE FixTLB(DllName as String)

            fModified=.f.

            DIMENSION asec[2] && preserve 2 sections of EXE

            h=FOPEN(DllName)

            fpos=FSEEK(h,0,2) && go to EOF

            FOR i = 1 TO 2

                  FSEEK(h,fpos-14,0)

                  pmt=FREAD(h,14)

                  sz=CTOBIN(substr(pmt,11,4),"4sr")

                  FSEEK(h,fpos-sz,0)

                  asec[i]=FREAD(h,sz)

                  fpos = fpos - sz

            ENDFOR

            FCLOSE(h)

            LOCAL otlb as "tli.tliapplication"

            LOCAL otli as TLI.TypeLibInfo

            otlb=NEWOBJECT("tli.tliapplication")

            otli=otlb.TypeLibInfoFromFile(DllName)

            SET TEXTMERGE TO t.idl ON noshow

            \//Generated .IDL FILE(by Visual Foxpro tlibtest by Calvin Hsia)

            \//

            \// typelib filename tlibtest.dll, generated <<DATETIME()>>

            \[

            \     uuid(<<CHRTRAN(otli.GUID,"{}","")>>),

            \     version(1.0),

            \     helpstring("<<otli.HelpString>>")

            \]

            \library <<otli.Name>>

            \{

            \     importlib("stdole2.tlb");

            \

            \     // Forward declare types defined in this typelib

            FOR EACH oCC as tli.CoClassInfo IN otli.CoClasses

                  FOR EACH oInt as  TLI.InterfaceInfo IN oCC.Interfaces

                        \     interface <<oInt.Name>>;

                  ENDFOR

            ENDFOR

            FOR EACH oCC as tli.CoClassInfo IN otli.CoClasses

                  FOR EACH oInt as  TLI.InterfaceInfo IN oCC.Interfaces

                        \     [

                        \           odl,

                        \           uuid(<<CHRTRAN(oInt.GUID,"{}","")>>),

                        \           helpstring("<<oInt.HelpString>>"),

                        \           hidden,

                        \           dual,

                        \           nonextensible,

                        \           oleautomation

                        \     ]

                        \     interface <<oInt.Name>> : <<oInt.ImpliedInterfaces.Item(1).Name>> {

                        FOR EACH oMem as TLI.MemberInfo IN oInt.Members

                              IF omem.MemberId < 0x6000000  && not the IDispatch/IUnknown

                                    cHelpstring=oMem.HelpString