Intel Fortran to call a VB .NET DLL and pass a string array (! NOT VB.net to call fortran! )

Rudy__Delcroit · ‎08-21-2019

Dear Fortran Guru,

I would like to pass an array of string FROM Inlet Fortran to VB.net but cannot manage it (the problem is not calling from Vb.NET to Fortran but FROM fortran TO call Vb. Net). The VB.NET subroutine doesn't fire.

Please find hereafter and attached a code sample. There are two projects :

- VbDLL is the Vb.NET project that creates the COM DLL to be called by fortran. (compiling it on your computer should register the DLL).

-Fortran is the executable that would call the VbDLL. I used module wizard with automation to create the interface code.

The sample works great for a integer, a real and a string but not for an array of integer ... Simply nothing happens ... No error message Nothing.

The final goal is passing a two dimension string array ...

     PROGRAM TESTSOLUTION
      
      USE VbDLL
      USE IFCOM
      USE IFAUTO
      USE IFWINTY
      Use IFCOMTY

      INTEGER(4) ret,Obj
      CHARACTER*20 STR      
      INTEGER(4) iTAB(4)
      

      Type(VARIANT) :: SA ! Variant SafeArray
      Type(sa_bounds) :: bounds(1)      

     
      iTAB(1)=1
      iTAB(2)=2
      iTab(3)=3
      iTab(4)=4
      
      
      call COMInitialize(ret)      
      If(ret.NE.0)GOTO 1159
          
C ----- Initialisation of object pointer ----------------
      call COMCreateObject("VbDLL.VBDLL",Obj,ret)
      If(ret.NE.0)GOTO 1159

C ------- COM TYPE CALL 
      CALL $VBDLL_Hello(Obj,ret)
      CALL $VBDLL_HelloInt(Obj,1,ret)
      CALL $VBDLL_HelloReal(Obj,2.,ret)
      STR="Hello World"
      CALL $VBDLL_HelloString(Obj,STR,ret)

C ------ With this call, Nothing happens......
      CALL $VBDLL_HelloArray1D(Obj,iTab,ret)
      
      
      
C ------ Using SafeArray doesn't allow to compile ....

      bounds(1)%lbound = lbound(iTab,1)
      bounds(1)%extent = ubound(iTab,1)
      
      SA%VT = VT_I4
      SA%VU%PTR_VAL = SafeArrayCreate(VT_I4, 1, bounds(1))
 
C uncomment this line to try       
C      CALL $VBDLL_HelloArray1D(Obj,SA,ret)
      

      
      Istatus = COMRELEASEOBJECT(Obj)
      Call COMUninitialize()
 1159 CONTINUE
      END

The interface generated by Module Wizard :

! VbDLL.f90

! This module contains the Automation interfaces of the objects defined in 
! C:\Users\vga\AppData\Local\Temp\VbDLL.TLB
! Generated by the Fortran Module Wizard on 08/20/19

	MODULE VbDLL
		USE IFWINTY
		USE IFAUTO
		IMPLICIT NONE
	

		! CLSIDs		
		TYPE (GUID), PARAMETER :: CLSID_VBDLL = &
			GUID(#4C31A291, #FC78, #323B, &
			  CHAR('BF'X)//CHAR('7C'X)//CHAR('31'X)//CHAR('41'X)// &
			  CHAR('FD'X)//CHAR('0F'X)//CHAR('BC'X)//CHAR('9D'X))


		! Module Procedures
		CONTAINS
  			SUBROUTINE $VBDLL_Hello($OBJECT, $STATUS)
				IMPLICIT NONE
	
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: $OBJECT	 ! Object Pointer
				!DEC$ ATTRIBUTES VALUE	:: $OBJECT
				INTEGER(4), INTENT(OUT), OPTIONAL	:: $STATUS	 ! Method status
				!DEC$ ATTRIBUTES REFERENCE			:: $STATUS
				INTEGER(4) $$STATUS
				INTEGER(INT_PTR_KIND()) invokeargs
				invokeargs = AUTOALLOCATEINVOKEARGS()
				$$STATUS = AUTOINVOKE($OBJECT, 1, invokeargs)
				IF (PRESENT($STATUS)) $STATUS = $$STATUS
				CALL AUTODEALLOCATEINVOKEARGS (invokeargs)
			END SUBROUTINE $VBDLL_Hello
  			SUBROUTINE $VBDLL_HelloArray1D($OBJECT, TableEntier, $STATUS)
				IMPLICIT NONE
	
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: $OBJECT	 ! Object Pointer
				!DEC$ ATTRIBUTES VALUE	:: $OBJECT
				INTEGER(4), DIMENSION(:), INTENT(INOUT), VOLATILE	:: TableEntier	! (SafeArray)
				!DEC$ ATTRIBUTES REFERENCE	:: TableEntier
				INTEGER(4), INTENT(OUT), OPTIONAL	:: $STATUS	 ! Method status
				!DEC$ ATTRIBUTES REFERENCE			:: $STATUS
				INTEGER(4) $$STATUS
				INTEGER(INT_PTR_KIND()) invokeargs
				invokeargs = AUTOALLOCATEINVOKEARGS()
				CALL AUTOADDARG(invokeargs, '$ARG1', TableEntier, AUTO_ARG_INOUT)
				$$STATUS = AUTOINVOKE($OBJECT, 5, invokeargs)
				IF (PRESENT($STATUS)) $STATUS = $$STATUS
				CALL AUTODEALLOCATEINVOKEARGS (invokeargs)
			END SUBROUTINE $VBDLL_HelloArray1D
  			SUBROUTINE $VBDLL_HelloInt($OBJECT, Entier, $STATUS)
				IMPLICIT NONE
	
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: $OBJECT	 ! Object Pointer
				!DEC$ ATTRIBUTES VALUE	:: $OBJECT
				INTEGER(4), INTENT(IN)	:: Entier	
				!DEC$ ATTRIBUTES REFERENCE	:: Entier
				INTEGER(4), INTENT(OUT), OPTIONAL	:: $STATUS	 ! Method status
				!DEC$ ATTRIBUTES REFERENCE			:: $STATUS
				INTEGER(4) $$STATUS
				INTEGER(INT_PTR_KIND()) invokeargs
				invokeargs = AUTOALLOCATEINVOKEARGS()
				CALL AUTOADDARG(invokeargs, '$ARG1', Entier)
				$$STATUS = AUTOINVOKE($OBJECT, 2, invokeargs)
				IF (PRESENT($STATUS)) $STATUS = $$STATUS
				CALL AUTODEALLOCATEINVOKEARGS (invokeargs)
			END SUBROUTINE $VBDLL_HelloInt
  			SUBROUTINE $VBDLL_HelloReal($OBJECT, Reel, $STATUS)
				IMPLICIT NONE
	
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: $OBJECT	 ! Object Pointer
				!DEC$ ATTRIBUTES VALUE	:: $OBJECT
				REAL(4), INTENT(IN)	:: Reel	
				!DEC$ ATTRIBUTES REFERENCE	:: Reel
				INTEGER(4), INTENT(OUT), OPTIONAL	:: $STATUS	 ! Method status
				!DEC$ ATTRIBUTES REFERENCE			:: $STATUS
				INTEGER(4) $$STATUS
				INTEGER(INT_PTR_KIND()) invokeargs
				invokeargs = AUTOALLOCATEINVOKEARGS()
				CALL AUTOADDARG(invokeargs, '$ARG1', Reel)
				$$STATUS = AUTOINVOKE($OBJECT, 3, invokeargs)
				IF (PRESENT($STATUS)) $STATUS = $$STATUS
				CALL AUTODEALLOCATEINVOKEARGS (invokeargs)
			END SUBROUTINE $VBDLL_HelloReal
  			SUBROUTINE $VBDLL_HelloString($OBJECT, Str, $STATUS)
				IMPLICIT NONE
	
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: $OBJECT	 ! Object Pointer
				!DEC$ ATTRIBUTES VALUE	:: $OBJECT
				CHARACTER(LEN=*), INTENT(IN)	:: Str	! BSTR
				INTEGER(4), INTENT(OUT), OPTIONAL	:: $STATUS	 ! Method status
				!DEC$ ATTRIBUTES REFERENCE			:: $STATUS
				INTEGER(4) $$STATUS
				INTEGER(INT_PTR_KIND()) invokeargs
				invokeargs = AUTOALLOCATEINVOKEARGS()
				CALL AUTOADDARG(invokeargs, '$ARG1', Str, AUTO_ARG_IN, VT_BSTR)
				$$STATUS = AUTOINVOKE($OBJECT, 4, invokeargs)
				IF (PRESENT($STATUS)) $STATUS = $$STATUS
				CALL AUTODEALLOCATEINVOKEARGS (invokeargs)
			END SUBROUTINE $VBDLL_HelloString
	END MODULE

And VB .NET code :

Imports System.Runtime.InteropServices ' Required for using MarshalAs

<Microsoft.VisualBasic.ComClass()> Public Class VBDLL

    Public Sub Hello()
        MsgBox("This function demonstrate the 'Hello World' with No Argument")
    End Sub

    Public Sub HelloInt(ByVal Entier As Integer)
        MsgBox("This function demonstrate the 'Hello World' with Integer : " & Entier)
    End Sub

    Public Sub HelloReal(ByVal Reel As Single)
        MsgBox("This function demonstrate the 'Hello World' with Real : " & Reel)
    End Sub

    Public Sub HelloString(ByVal Str As String)
        MsgBox("This function demonstrate the 'Hello world' with a string : " & Str)
    End Sub


    ' I also tried this declaration type but it doesn't work either.
    'Public Sub HelloArray1D(<MarshalAs(UnmanagedType.SafeArray, SafeArraySubType:=VarEnum.VT_I4)> ByRef TableEntier() As Integer)

    Public Sub HelloArray1D(ByRef TableEntier() As Integer)
        ' When calling this function from fortran nothing happens.
        For i = 0 To TableEntier.Length - 1
            MsgBox("This function demonstrate the 'Hello world' with an array of 1 dimension : " & TableEntier(i))
        Next
    End Sub



    ' This are the next step that I would like to do. 

    'Public Sub HelloArray2D(ByRef TableEntier(,) As Integer)
    '    MsgBox("This function demonstrate the 'Hello world' with an array of 2 dimension : " & TableEntier(0, 0))
    'End Sub

    'Public Sub HelloArray2DString(ByRef TableStr(,) As String)
    '    MsgBox("This function demonstrate the 'Hello world' with an array of 2 dimension : " & TableStr(0, 0))
    'End Sub


End Class

FortranFan · ‎08-21-2019

@Rudy, Delcroit,

Take a look at this thread, especially Quote #2 with the details and attachments:

https://software.intel.com/en-us/forums/intel-visual-fortran-compiler-for-windows/topic/509148