Passing String Arrays to COM object

[FortranFan]

Hi,

I'm having trouble passing string arrays from Fortran to a COM object. A code sample is shown below. Can someone please review and let me know what I'm doing wrong? Thanks much in advance.

My research group usesboth Compaq Visual Fortran (CVF version 6.6a) as well as Intel Visual Fortran (IVF version 9.1). The sample shown below is from aproject build usingCVF, but I believe it'll show up in IVF as well. I've gone over both CVF code samples and IVF documentation extensively as well as other posts on this forum and have tried to follow all the recommendations. But I'm new to this and could be making some elementary mistakes; my sincere apologies if that's the case.

PROGRAM TestCOM

USE DFCOMTY
USE DFCOM
USE MYCOMOBJ

IMPLICIT NONE

INTERFACE

INTEGER*4 FUNCTION SysAllocStringByteLen(psz, len);
!DEC$IF DEFINED(_X86_)
!DEC$ ATTRIBUTES DEFAULT, STDCALL, ALIAS : '_SysAllocStringByteLen@' :: SysAllocStringByteLen
!DEC$ELSE
!DEC$ ATTRIBUTES DEFAULT, STDCALL, ALIAS : 'SysAllocStringByteLen' :: SysAllocStringByteLen
!DEC$ENDIF
INTEGER*4, INTENT(IN) :: psz, len
!DEC$ ATTRIBUTES VALUE :: psz, len
END FUNCTION SysAllocStringByteLen

END INTERFACE

!.. Object Pointer
INTEGER*4 :: comobject

!.. Local Variables
INTEGER*4 :: Istatus
REAL*8 :: Volume
REAL*8 :: Pressure
INTEGER*4 :: Material
CHARACTER(LEN=12) :: Names(3)
!.. Variables for Safe Arrays
INTEGER*4 ISafeNames
INTEGER*4 ISafeConc
TYPE(sa_bounds), DIMENSION(1) :: Bounds
INTEGER*4 :: I
CHARACTER(LEN=13) :: NameString
POINTER(StringPtr,NameString)
INTEGER*4 LenString

!.. Initialize object pointers; This is necessary in order for the
! program to release all objects when it is done
CALL COMINITIALIZE(Istatus)

!.. Create my COM object
comobject = 0
CALL COMCREATEOBJECTBYGUID(CLSID_MYCOM, CLSCTX_ALL, IID_IMYCOM, comobject, Istatus)

!.. Set the container
Volume = 0.01D0
Pressure = 200.0D0
Material = MATERIAL_ALUMINUM
!.. !!! Following CALL works SUCCESSFULLY :-)))
Istatus = $IMYCOM_SetContainer(comobject, Volume, Pressure, Material)

!.. Specify the Names
Names(1) = 'WATER'
Names(2) = 'JUICE'
Names(3) = 'SUGAR'
!.. Convert the Components and Concentration vectors into an OLE SafeArray
Bounds(1)%extent = UBOUND(Names, 1)
Bounds(1)%lbound = 1
ISafeNames = SafeArrayCreate(VT_BSTR, 1, Bounds(1))
DO I=1,Bounds(1)%extent
StringPtr = SysAllocStringByteLen(LOC(Names(I)), LEN_TRIM(Names(I)))
Istatus = SafeArrayPutElement(ISafeNames, I, StringPtr)
CALL SysFreeString(StringPtr)
END DO

!.. !!! Following CALL does NOT WORK :-(((
Istatus = $IMYCOM_SetNames(comobject, ISafeNames)

!.. Release all objects
Istatus = COMRELEASEOBJECT(comobject)
CALL COMUNINITIALIZE()

END PROGRAM TestCOM

!.. The following definitons are part of the Module generated by the CVF Wizard
INTEGER(4) FUNCTION $IMYCOM_SetContainer($OBJECT, Vol, MaxP, Matl)
!DEC$ ATTRIBUTES DLLEXPORT :: $IMYCOM_SetContainer
IMPLICIT NONE

INTEGER(INT_PTR_KIND()), INTENT(IN) :: $OBJECT ! Object Pointer
!DEC$ ATTRIBUTES VALUE :: $OBJECT
REAL(8), INTENT(IN) :: Vol
!DEC$ ATTRIBUTES REFERENCE :: Vol
REAL(8), INTENT(IN) :: MaxP
!DEC$ ATTRIBUTES REFERENCE :: MaxP
INTEGER, INTENT(IN) :: Matl ! MATERIAL
!DEC$ ATTRIBUTES REFERENCE :: Matl
INTEGER(4) $RETURN
INTEGER(INT_PTR_KIND()) $VTBL ! Interface Function Table
POINTER($VPTR, $VTBL)
$VPTR = $OBJECT ! Interface Function Table
$VPTR = $VTBL + 216 ! Add routine table offset
IMYCOM_SetContainer_PTR = $VTBL
$RETURN = IMYCOM_SetContainer($OBJECT, Vol, MaxP, Matl)
$IMYCOM_SetContainer = $RETURN
END FUNCTION $IMYCOM_SetContainer

INTEGER(4) FUNCTION $IMYCOM_SetNames($OBJECT, SpecNames)
!DEC$ ATTRIBUTES DLLEXPORT :: $IMYCOM_SetNames
IMPLICIT NONE

INTEGER(INT_PTR_KIND()), INTENT(IN) :: $OBJECT ! Object Pointer
!DEC$ ATTRIBUTES VALUE :: $OBJECT
INTEGER(INT_PTR_KIND()), INTENT(INOUT) :: SpecNames ! BSTR(SafeArray)
!DEC$ ATTRIBUTES REFERENCE :: SpecNames
INTEGER(4) $RETURN
INTEGER(INT_PTR_KIND()) $VTBL ! Interface Function Table
POINTER($VPTR, $VTBL)
$VPTR = $OBJECT ! Interface Function Table
$VPTR = $VTBL + 224 ! Add routine table offset
IMYCOM_SetNames_PTR = $VTBL
$RETURN = IMYCOM_SetNames($OBJECT, SpecNames)
$IMYCOM_SetNames = $RETURN
END FUNCTION $IMYCOM_SetNames