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
Anonymous
September 04, 2005
The comment has been removedAnonymous
September 04, 2005
The comment has been removedAnonymous
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 confirmAnonymous
May 16, 2007
It’s simple to create a VFP object that can be used within other applications. I show how useful it isAnonymous
May 09, 2008
The comment has been removedAnonymous
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 removedAnonymous
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.