Allowing Optional parameters in your COM objects

It’s simple to create a VFP object that can be used within other applications. I show how useful it is in Blogs get 300 hits per hour: Visual FoxPro can count.

That sample builds the T1.C1 object that uses methods with multiple parameters. T1.C1 is a general purpose server which in that example is shown to serves up web pages on a web server. It can be used for running any VFP code. Because the code to run is not built into the object itself, modifying the web server functionality doesn’t require shutting down and restarting the web site or web application as most other applications do.

When calling Foxpro methods and functions, all parameters are optional by default. In other words, if the function expects 3 parameters, you can still pass 0 arguments, and the unpassed parameters will default to False(.f.)

When building a COM object, Foxpro generates a TypeLibrary describing all the methods and their parameters. When calling that object via late binding, the additional required parameters default to .f.

It’s simple to modify the generated TypeLib to indicate some parameters are optional: we just add a little code to the project hook posted in Strongly typed methods and properties

The sample below adds to the same project hook to massage the generated TypeLibrary to indicate optional parameters.

If the helpstring has a “|” character, the following text is interpreted as a TypeLibrary directive.

  • If it starts with “%”, then the value is interpreted as an integer (like 2), indicating that parameters starting with the 2nd are optional.
  • Else it is interpreted as a strongly typed object to return (see Strongly typed methods and properties)

Run the code below, then start Excel or VB.Net

Excel

In Excel, choose Tools->Macros->VB Editor. For the menu option to open VB Editor in Excel 2007, use the Developer Tab on your ribbon. If it’s not there, choose Office Button, Excel Options, Show Developer Tab in Ribbon. Alt-F11 works in both versions of Excel. To use early binding, add a reference to T1.DLL by choosing Tools->References and add a checkmark to “T1 Type Library”

Then Insert->Module and paste this code

Sub foo()

    Dim xEarly As New t1.c1 ' for early binding

    MsgBox (xEarly.MyEval("iif(sys(2334)='1','Early bound call ','Late bound call ') + version(1)"))

    Set xLate = CreateObject("t1.c1") ' for late binding

MsgBox (xLate.MyEval("iif(sys(2334)='1','Early bound call ','Late bound call ') + version(1)"))

End Sub

Now hit F5 to run the code

The code uses SYS(2334) to indicate whether or not it was an early or late bound call.

Because the Optional parameters are specified, the line is simpler than

MsgBox (x.MyEval("version(1)", 0, 0, 0, 0))

Also, with early binding Excel’s intellisense indicates optional parameters with square brackets.

To use late binding, don’t add the reference, replace the Dim line with this: Set x = CreateObject(“t1.c1”)

VB.Net

In Visual Studio, choose File->New->Project->VB->Windows Form Application. Again, add a reference to get early binding (Late binding works as in Excel.) Project->Add Reference->Browse and navigate to the T1.DLL you just built.

Dbl click the form to add this code to the Load method:

        Dim xEarly As New t1.c1 ' for early binding

        Dim cCmd As String = "iif(sys(2334)='1','Early bound call ','Late bound call ') + version(1)"

        MsgBox(xEarly.MyEval(cCmd))

        Dim xLate = CreateObject("t1.c1") ' for late binding

        MsgBox(xLate.MyEval(cCmd))

        'This one uses reflection to make the early one invoke latebound

        MsgBox(xEarly.GetType().InvokeMember("MyEval", Reflection.BindingFlags.InvokeMethod, _

                                 Nothing, xEarly, New Object() {cCmd}))

        Me.Close() ' close the form

In C#:

            t1.c1 xEarly = new t1.c1Class();

            string cCmd = "iif(sys(2334)='1','Early bound call ','Late bound call ') + version(1)";

            System.Windows.Forms.MessageBox.Show(xEarly.MyEval(cCmd, 0, 0, 0, 0).ToString());

            string cLate = xEarly.GetType().InvokeMember("MyEval",System.Reflection.BindingFlags.InvokeMethod,

                null,xEarly,new object[] {cCmd}).ToString();

            System.Windows.Forms.MessageBox.Show(cLate);

            this.Close(); // close the form

Does C# support late binding? No, except through reflection.see Programming Office Applications Using Visual C#

Does C# support optional params? (ILDASM of Inerop.T1.Dll looks the same as for VB.) No: see Understanding Optional Parameters in COM Interop

See also

Binding for Office automation servers with Visual C# .NET

Programming with Visual Basic Versus C#

Use temporary projects in Visual Studio

Blogs get 300 hits per hour: Visual FoxPro can count.

A Visual Basic COM object is simple to create, call and debug from Excel

CLEAR

SET SAFETY OFF

*!* Use a Project hook to make general purpose COM server with optional parameters

*!* Run this code in Excel

*!* Sub foo()

*!* Dim x As New t1.c1 ' for early binding

*!* MsgBox (x.MyEval("iif(sys(2334)='1','Early bound call ','Late bound call ') + version(1)"))

*!* Set x2 = CreateObject("t1.c1") ' for late binding

*!* MsgBox (x2.MyEval("iif(sys(2334)='1','Early bound call ','Late bound call ') + version(1)"))

*!* End Sub

*!* in VB.Net:

*!* Dim xEarly As New t1.c1 ' for early binding

*!* Dim cCmd As String = "iif(sys(2334)='1','Early bound call ','Late bound call ') + version(1)"

*!* MsgBox(xEarly.MyEval(cCmd))

*!* Dim xLate = CreateObject("t1.c1") ' for late binding

*!* MsgBox(xLate.MyEval(cCmd))

*!* 'This one uses reflection to make the early one invoke latebound

*!* MsgBox(xEarly.GetType().InvokeMember("MyEval", Reflection.BindingFlags.InvokeMethod, _

*!* Nothing, xEarly, New Object() {cCmd}))

*!* Me.Close() ' close the form

#if .t.

TEXT TO mystr NOSHOW

DEFINE CLASS c1 as session olepublic

      proc MyDoCmd(cCmd as string,p2 as Variant,p3 as Variant,p4 as Variant,p5 as Variant) ;

      helpstring 'Execute a command|%2'

            &cCmd

      proc MyEval(cExpr as string,p2 as Variant,p3 as Variant,p4 as Variant,p5 as Variant) ;

      helpstring 'Evaluate an expression|%2'

        RETURN &cExpr

ENDDEFINE

ENDTEXT

STRTOFILE(mystr,"c1.prg")

IF !FILE("t1.pjx") && only rebuild if doesn't exist so we don't regen guids and pollute registry

      BUILD PROJECT t1 FROM c1

ENDIF

MODIFY PROJECT t1 nowait

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

nerror=0

TRY

      BUILD MTDLL t1 FROM t1

CATCH TO oex

      ?oex.message

      nerror=1

FINALLY

      _vfp.ActiveProject.Close

ENDTRY

IF nerror>0

      RETURN

ENDIF

*retu

#endif

LOCAL x as t1.c1

x=CREATEOBJECTEX("t1.c1","","")

?x.MyEval("_vfp.servername")

?x.MyEval("iif(sys(2334)='1','Early bound call ','Late bound call ') + version(1)")

 

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+ "LONG"

            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

                                    nOptional=1000

                                    cRetType=this.GetType(oMem.ReturnType)

                                    IF ""!=cHelpstring

                                          cRest=cHelpstring

                                          n=AT("|",cHelpstring)

                                          cHelpString=LEFT(cHelpstring,n-1) && the real helpstring. Now process directives

                                          *Directives: start with "|"

                                          IF RIGHT(cRest,1) != "|" && add terminator if needed

                                                cRest=cRest+"|"

                                          ENDIF

                                          DO WHILE n>1

                                                fModified=.t.

                                                cRest=SUBSTR(cRest,n+1)

                                                n=AT("|",cRest) && see if there are any more directives

                                                IF n>0

                                                      cTemp=LEFT(cRest,n-1)

                                                      cTemp=SUBSTR(cTemp,1) && remove the delimiters

* ?"===",cRest,n,cTemp

                                                      DO CASE

                                                      CASE LEFT(cRest,1)="%"

                                                            nOptional=VAL(SUBSTR(cTemp,2))

                                                      OTHERWISE

                                                            cRetType=cTemp

                                                      ENDCASE

                                                ENDIF

                                          ENDDO

                                    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.

                                          nParmCount=0

                                          FOR EACH oParm as tli.ParameterInfo IN omem.Parameters

                                                nParmCount=nParmCount+1

                                                cAttr=""

                                                IF BITAND(oParm.Flags,1)>0

                                                      cAttr=cAttr+", in"

                                                ENDIF

                                                IF nParmCount >= nOptional

                                                      cAttr=cAttr+", optional"

                                                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 = "c:\Program Files\Microsoft Visual Studio 9.0\Vc\bin\vcvars32.bat"

                  IF !FILE(cVars)

                        cVars=LOCFILE("c:\Program Files\Microsoft Visual Studio 8\Vc\bin\vcvars32.bat")

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

                  ENDIF

                  IF !FILE(cVars)

                        ?"Aborting: can't find VS"

                        RETURN

                  ENDIF

                  TEXT TO mybat textmerge

                        call "<<cVars>>"

                        midl t.idl

                  ENDTEXT

                  STRTOFILE(mybat,"t.bat")

                  !cmd /c t.bat > t.txt

                  ?FILETOSTR("t.txt")

                  ?"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"

            ELSE

                  ?"TypeLib Modification unnecessary"

            ENDIF

      PROCEDURE AfterBuild(nError)

            IF nError=0

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

            ENDIF

ENDDEFINE

End of code