String Array from VB to FORTRAN

[arashok]

Hi,

How to pass string array from VB 6.0 to FORTRAN.

Regards

Ashok

[wkramer]

I you are using or have access to CVF take a look at the mixed language sample for VB on arrays: DF98SamplesMixLangVbArrays.

The attached code is based on this sample.

Good luck,

Walter Kramer

Code:

subroutine GetLabels(nG,Labels)
  !dec$ attributes dllexport, alias : "GetLabels" :: GetLabels
  !dec$ attributes reference :: Labels
  use dfcom
  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
  integer SADummy
  pointer (Labels,SADummy)  ! Pointer to a SafeArray structure
  integer(4), intent(in) :: nG
  character(LEN=1) outString
  pointer (outStringPtr, outString)
  integer, parameter :: F90_STRING_LEN = 256
  character(len=F90_STRING_LEN) :: f90string 
  integer :: i, iRes, lbound, ubound

  iRes = SafeArrayGetLBound(Labels, 1, lbound)
  iRes = SafeArrayGetUBound(Labels, 1, ubound)
  do i = lbound, ubound
    f90string="fluppy"
    outStringPtr = SysAllocStringByteLen(loc(f90string), len_trim(f90string))
    if (.NOT. (outStringPtr == 0)) then
      iRes = SafeArrayPutElement(Labels, i, outStringPtr)
      call SysFreeString(outStringPtr)
    end if  
  end do  
  return  
end subroutine GetLabels

VB code:
Private Declare Sub GetLabels Lib "Labels.dll" (nG As Long, Labels() As String)
Private Labels() As String
Private nG As Long
nG=10
ReDim GarUnitLabels(nG)
Call GetLabels(nG, Labels)