Strongly typed methods and properties

Article
09/02/2005

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

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

\ [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

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

Anonymous
September 04, 2005
The comment has been removed
Anonymous
September 04, 2005
The comment has been removed
Anonymous
September 11, 2005
Calvin,

My reaction is the same as Rick's... Cool!
Anonymous
November 23, 2005
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!
Anonymous
January 06, 2006
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?
Anonymous
December 20, 2006
Thank you! [url=http://pmmdwqkn.com/grll/hsqc.html]My homepage[/url] | [url=http://vpgylnxb.com/jfox/nmss.html]Cool site[/url]
Anonymous
April 13, 2007
Try this on Windows XP or Vista (I don’t remember if manifests are allowed on Win2000: can someone confirm
Anonymous
May 16, 2007
It’s simple to create a VFP object that can be used within other applications. I show how useful it is
Anonymous
May 09, 2008
The comment has been removed
Anonymous
March 03, 2009
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.
Anonymous
January 31, 2010
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.
Anonymous
February 15, 2011
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.
Anonymous
February 24, 2016
The comment has been removed
Anonymous
February 25, 2016
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.

Partager via

Strongly typed methods and properties

Comments

Ressources supplémentaires