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
