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


                                    cRetType=this.GetType(oMem.ReturnType)


                                    IF “”!=cHelpstring


                                          IF “|”$chelpstring


                                                fModified=.t.


                                                cRetType=SUBSTR(cHelpstring,AT(‘|’,cHelpstring)+1)+”*”


                                                cHelpString=LEFT(cHelpstring,AT(‘|’,cHelpstring)-1)


                                          ENDIF


                                    ENDIF


                                    \           [id(<<TRANSFORM(omem.MemberId,”@0x”)>>)


                                    IF oMem.InvokeKind>1


                                          \\,<<IIF(oMem.InvokeKind==2,”propget”, “propput”)>>


                                    ENDIF


                                    IF “”!=cHelpstring


                                          \\,helpstring(“<<cHelpString>>”)


                                    ENDIF


                                    \\]


                                    \           HRESULT <<oMem.Name>>(


                                    IF INLIST(oMem.InvokeKind,2,4)


                                          IF oMem.InvokeKind=2


                                                \\[out, retval] <<cRetType>>* <<oMem.Name>>


                                          ELSE


                                                \\[in] <<cRetType>>  <<oMem.Name>>


                                          ENDIF


                                          \\);


                                    ELSE


                                          fHasAttr = .f.


                                          FOR EACH oParm as tli.ParameterInfo IN omem.Parameters


                                                cAttr=””


                                                IF BITAND(oParm.Flags,1)>0


                                                      cAttr=cAttr+”, in”


                                                ENDIF


                                                IF BITAND(oParm.Flags,2)>0


                                                      cAttr=cAttr+”, out”


                                                ENDIF


                                                IF BITAND(oParm.Flags,8)>0


                                                      cAttr=cAttr+”, retval”


                                                ENDIF


                                                IF “”!=cAttr


                                                      \\[<<SUBSTR(cAttr,3)>>]


                                                ENDIF


                                                \\ <<this.gettype(oParm.VarTypeInfo)>> <<oParm.Name>>


                                                IF omem.Parameters.Count>0


                                                      \\,


                                                ENDIF


                                          ENDFOR


                                          \\[out, retval] <<cRetType>>* RetVal


                                          \\);


                                    ENDIF


                              ENDIF


                        ENDFOR


                        \     };


                  ENDFOR


            ENDFOR


            \


            FOR EACH oCC as tli.CoClassInfo IN otli.CoClasses


                  \     [


                  \           uuid(<<CHRTRAN(occ.GUID,”{}”,””)>>),


                  \           helpstring(“<<occ.HelpString>>”)


                  \     ]


                  \     coclass <<occ.Name>> {


                  FOR EACH oInt as  TLI.InterfaceInfo IN oCC.Interfaces


                        \           [default] interface <<oInt.Name>>;


                  ENDFOR


                  \     };


 


            ENDFOR


            \};


            SET TEXTMERGE to


            otlb=0      && release, so we can insert new typelib into it


            otli=0


            IF fModified


                  cVars=LOCFILE(“c:\Program Files\Microsoft Visual Studio .NET 2003\Vc7\bin\vcvars32.bat”)


                  IF !FILE(cVars)


                        cVars=”d”+SUBSTR(cVars,2)


                  ENDIF


                  TEXT TO mybat textmerge


                        call “<<cVars>>”


                        midl t.idl


                  ENDTEXT


                  STRTOFILE(mybat,”t.bat”)


                  !cmd /c t.bat


                  ?”done midl”


                  DECLARE integer BeginUpdateResource IN WIN32API string , integer


                  DECLARE integer EndUpdateResource IN WIN32API integer, integer


                  DECLARE integer UpdateResource IN WIN32API integer,string,integer,integer, string, integer


                  DECLARE Integer GetLastError IN win32api


                  h=BeginUpdateResource(DllName,0)


                  strTlb=FILETOSTR(“t.tlb”)


                  UpdateResource(h,”TYPELIB”,1,0x409,0,0)


                  UpdateResource(h,”TYPELIB”,1,0x409,strTlb,LEN(strTlb))


                  IF EndUpdateResource(h,0)=0


                        ?”Err=”,GetLastError()


                  ENDIF


                  h=FOPEN(DllName,2)


                  fpos=FSEEK(h,0,2)


                  FOR i = 1 TO 2


                        FWRITE(h,asec[i])


                  ENDFOR


                  FCLOSE(h)


                  ?”TypeLib Modification Done”


            ENDIF


      PROCEDURE AfterBuild(nError)


            IF nError=0


                  this.FixTLB(JUSTSTEM(_vfp.ActiveProject.Name)+”.dll”)


            ENDIF


ENDDEFINE


 


DEFINE CLASS Customer as Session olepublic


      Cust_id=”cust_id”


      CompanyName=”compname”


      DIMENSION OrderProp_COMATTRIB[4]


      OrderProp=0


      OrderProp_COMATTRIB[2]=”orderprop helpstring|Iorders”


      PROCEDURE GetOrder(bstrCust as String) as variant helpstring “Getorder method|Iorders”


            RETURN CREATEOBJECT(“tlibtest.Orders”)


ENDDEFINE


 


DEFINE CLASS Orders AS Session OLEPUBLIC


      order_id = “orderid returned successfully”


      OrderDate=DATE()


     


ENDDEFINE


 


*5/10/07: editied to fix minor bug with more than 1 param in oParm loop

Comments (14)

  1. Rick Strahl says:

    Looks like there’s a small bug with the type casting:

    CASE nType=3

    cstr = cstr + "int"

    *cstr=cstr+ "integer" // invalid

    The Midl compiler failed on me when I had an integer value in the inbound parameters. Works well now.

    Just for others who want to wrap this up other than a project hook you can just put the class into a PRG and do:

    LPARAMETERS lcDll

    IF !EMPTY(lcDLL)

    o = CREATEOBJECT(‘FixTypeLibrary’)

    ? o.FixTlb(lcDLL)

    ENDIF

    #DEFINE VS_PATH "D:programsvstudio2003Vc7binvcvars32.bat"

    Note I renamed the class and replaced the hardcoded VS path which might be a good idea. No heavy duty testing here, but it works for the simple scnearios I tried generically. Cool

  2. If you’re using COM with VFP you may have run into a nasty problem that doesn’t allow VFP to create a typelibary containing parameters, return values or property types of other classes/interfaces that exist in the current project. Calvin posted a solution to this problem the other day and here is some additional information around the topic.

  3. Craig Boyd says:

    Calvin,

    My reaction is the same as Rick’s… Cool!

  4. Anatoliy Mogylevets says:

    Calvin,

    This is great! Thanks for sharing your knowledge with the community.

    You preserve 2 sections of EXE before updating the resources. As I understand, without this nice trick, VFP dll or executable would be damaged/truncated.

    If possible, could you explain why this is required. Is there someting wrong with the UpdateResource API, or it’s just because of some specifics of VFP executable format?

    Thanks!

  5. Dan Thomas says:

    It appears that strong typing with more than one method parameters generates an midl compile error?…

    FUNCTION MyMethod (MyParam1 AS integer) AS integer

    … this works

    FUNCTION MyMethod (MyParam1 AS integer, MyParam2 AS string) AS integer

    .. this generates errors during the midl compile

    Any ideas?

  6. Try this on Windows XP or Vista (I don’t remember if manifests are allowed on Win2000: can someone confirm

  7. It’s simple to create a VFP object that can be used within other applications. I show how useful it is

  8. Jon Goad says:

    I had to change this line:

    strTlb=FILETOSTR("t.tlb")

    to this:

    strTlb=FILETOSTR("tlibtest.tlb")

    Without this change, it gives the error that the file t.tlb does not exist.

  9. TZuidema says:

    Hi,

    At the end, when the (2) sections are restored to the EXE, the order of the sections is reversed.

    That prohibited COM registration on our EXE.

    So instead of the last FOR i = 1 TO 2, use

    FOR i = 2 TO 1 STEP -1

    Regards,

    Timo.

  10. very richart says:

    when i tried your program in VFP 8.0 get error like this "TOO MANY PARAMETER" on script sz=CTOBIN(substr(pmt,11,4),"4sr").

    what wrong about that?

    could you please fix that.

  11. Grzegorz Majna says:

    Thanks, great solution, it helped me a lot, I found a little bug, here is the fix:

    instead of:

    CASE nType=3

                     cstr=cstr+ "integer"

    or

    CASE nType=3

                     cstr=cstr+ "int"

    there should be:

    CASE nType=3

                     cstr=cstr+ "long"

    It eliminates the problem with using COMATTRIB for Integer and Long class properties when you want to use the library from .NET. When I used "int" version, the Long or Integer properties of COM object were always zero, after aplying "long" the problem dissapeared and I got proper results.

    Tested with VFP 9.0 sp2 and VS 2010.

  12. Mark Jr. says:

    Hello, People = D

    I'm having trouble with this solution between .NET and Visual FoxPro. I have an  very large application in VFP and i need use some logic in a  new .NET application.

    I'm trying to create a library, but I have to share some objects between the .NET and FoxPro. just simple objects. With the  Calvin class I managed to get the .NET understand the type of object that the FoxPro method will return. But when I try to use a method of that object I get the following problem:

    Exception from HRESULT: 0x80004002 (E_NOINTERFACE)

    Any idea? I know the reason of the problem but I cant find solution ..

  13. Mark Jr. says:

    Well, I found a solution.

    I am finishing the creation of a wrapper that enables the .NET communicate with FoxPro through objects. The biggest trick is that objects are not shared and remain in the FoxPro memory.