!!!  filename : arrays.f90 

!!! This subroutine takes as input an array of strings from Visual Basic,
!!! and writes each string out to a datafile.
!!! It also writes various pieces of information about the array to that
!!! file, for illustrative purposes.
!!!
!!! Original example by Lorri Menard, Compaq Fortran Engineering
!!! Enhancements by John Termine, Swiss Re Investors

subroutine ForCall (VBArray)
	!dec$ attributes dllexport, stdcall, alias : "ForCall" :: ForCall

!!! Declare the array of strings (SafeArray) as being passed by REFERENCE.
!!!  This must be explicit because stdcall defaults to pass-by-value.

	!dec$ attributes reference :: VBArray


!!! The following module (dfcom) declares the interfaces to SafeArrayxxx
!!! Since the interfaces to SafeArrayxxx are incomplete, we will have to 
!!! declare an interface to SysAllocStringByteLen explicitly below.
  use dfcom

  implicit none

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! API declaration in Oleauto.h 
!!! WINOLEAUTAPI_(BSTR) SysAllocStringByteLen(LPCSTR psz, UINT len)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!


!!! Declare the SafeArray as a pointer.  Use a generic 
!!! integer as something to point to, because the POINTER statement
!!! requires a pointee to point to.

!!! When this is declared as a pointer it will automatically expand
!!! to fit the size of a pointer for the particular platform.  Today
!!! that is 32 bits - in the future, that may expand.
  
  pointer (VBArray,SADummy)  !Pointer to a SafeArray structure  
  integer SAdummy   

!!! SafeArrayGetElement returns a single element of the array.  Since the array
!!! is an array of VB strings, the element returned is a BSTR.  BSTRs are length
!!! prefixed strings used in COM / OLE Automation (including VB).  A BSTR is a pointer to
!!! a UNICODE string whose length is stored in the DWORD that precedes it.  It is usually 
!!! terminated with a two byte null and it may contain embedded nulls. 
 
!!! VB will always do a UNICODE to ANSI conversion before passing a string to a standard DLL.
!!! This is not an accident, but a requirement, if only because Win9x does not support UNICODE 
!!! versions of WIN32 API functions.  For more info, see MS KB articles Q199824, Q187675, Q187912, or 
!!! "Dan Appleman's VB Programmer's Guide to the Win32 API" which states :
!!! "Visual Basic uses UNICODE internally, but always converts strings to ANSI (8 bit) before using
!!! them as parameters to API or DLL functions defined using the Declare statement."

!!! Therefore, the BSTRs that are returned from SafeArrayGetElement and that VB expects to 
!!! get back are ANSI BSTRs and so we must take care to use SysAllocStringByteLen and 
!!! SysStringByteLen as opposed to their full UNICODE cousins SysAllocString and SysStringLen


!!! Set up the appropriate structures.  Declare a character string
!!! that is "long enough".  It doesn't actually take up any space
!!! in your program; it is used as a template to describe the memory
!!! pointed to by the pointer StringPtr.  
!!! For more info see "Compaq Fortran Pointers" in the CVF documentation
  
  !!! StringPtr will point to BSTR recieved from SafeArrayGetElement.  We will 
  !!! manipulate the BSTR pointed to by StringPtr in our f90 code using "mystring"
  integer, parameter :: LONG_ENOUGH_BUFFER = 2048 !!! - arbitrary length
  character(LEN=LONG_ENOUGH_BUFFER) mystring
  pointer (StringPtr, mystring)
    
  !!! outStringPtr will point to BSTR created with SysAllocStringByteLen
  !!! This is the BSTR we will use to copy back to the array using SafeArrayPutElement
  character(LEN=1) outString        !!! LEN=1 is adequate since we'll never 
  pointer (outStringPtr, outString) !!! reference outString, just outStringPtr
                                    !!! could just as well have declared outStringPtr 
									!!! as integer(4)

  
  integer, parameter :: F90_STRING_LEN = 256  !!! - arbitrary length for f90 string
  !!! Use f90 string to create & manipulate a string that we will then use to create a 
  !!! BSTR to back into the VB array.  Not using integer pointer here so that 
  !!! don't have to use malloc to allocate memory for it.  It would just 
  !!! cloud the issues.
  character(len=F90_STRING_LEN) :: f90string 

  integer :: i, iRes, lbound, ubound, length

  ! Body of code

!!! example of using the VB array as an IN parameter

  ! Create the data file  
  open (2, file="testout.txt", status="unknown")

  write (2, *) "Details of the array passed by VB"  
  ! Get the lower array bound
  iRes = SafeArrayGetLBound(VBArray, 1, lbound)
  write (2, *) "GetLBound gives ", lbound 
  ! Get the upper array bound
  iRes = SafeArrayGetUBound(VBArray, 1, ubound )
  write (2, *) "GetUBound gives ", ubound

!!! In this next loop, get each element of the array.  This returns a
!!!  pointer to a copy of the string, which can then be referenced through
!!!  mystring.  The length of the string is retrieved by the routine SysStringByteLen.
!!! This copy must be freed when we're done with it.

  write (2, *) "Strings from the array:"  
  do i = lbound, ubound
    iRes = SafeArrayGetElement(VBArray, i, LOC(StringPtr)) !!! FYI, copies as ANSI
    length = SysStringByteLen(StringPtr)
    write (2, *) mystring(1:length)
    call SysFreeString(StringPtr)
  end do  !Done with the data file. 
  close (2)


!!! example of using the VB array as an INOUT parameter

!!! This next loop writes a string back into each element of the array.
!!! The proper way to reassign BSTRs is to allocate a new BSTR with the new character
!!! string, free the original BSTR, and then reset the original BSTR's pointer to point to 
!!! the new BSTR.  SysReAllocString is a function that simplifies this, but, for UNICODE
!!! BSTRs.  There is no SysReAllocStringByteLen, so we must do it the long way.

  !Let's try writing back into VB's array 
  !!! Create a new string to copy using the array element & concatenate another string
  do i = lbound, ubound
    !!! Get a copy of the array element
    iRes = SafeArrayGetElement(VBArray, i, LOC(StringPtr)) 
    !!! Get the length of the array element
    length = SysStringByteLen(StringPtr)
    
    f90string = mystring(1:length) // " is Element#" // char(i+1+48)
    !!! Do not need to NULL terminate f90string.  SysAllocStringByteLen(psz,len)
    !!! allocates a new BSTR of len bytes, copies len bytes from psz and then
    !!! appends a null character. 

    !!! A new BSTR is created & copied from the first len_trim(f90string) 
    !!! characters of f90string
    outStringPtr = SysAllocStringByteLen( loc(f90string), len_trim(f90string) )

    if (.NOT. (outStringPtr == 0)) then !!! Test for memory allocation failure
										!!! On failure do nothing.(except free StringPtr)
      iRes = SafeArrayPutElement(VBArray, i, outStringPtr)
      call SysFreeString(outStringPtr)
    end if  
    call SysFreeString(StringPtr)
  end do  
  return  
end subroutine ForCall
