Announcement

Collapse
No announcement yet.

SafeArrayPutElement (Repost ! - who deleted previous ?)

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Florent Heyworth
    replied
    The MSDN documentation is correct in that this is how
    multi-dimensional arrays must be treated - it does not apply
    to one-dimensional arrays. In other words when using
    SafeArrayPutElement() with a one dimensional array you
    only needed to increment the index element.

    Cheers

    Florent

    ------------------




    [This message has been edited by Florent Heyworth (edited July 26, 2001).]

    Leave a comment:


  • Steven Pringels 3
    replied
    Thanks a lot Florent ! That does the trick
    quite well.

    Although the MSDN say about the 2nd parameter in SafeArrayPutElement
    rgIndices
    Pointer to a vector of indexes for each dimension of the array.
    The right-most (least significant) dimension is rgIndices[0].
    The left-most dimension is stored at rgIndices[psa->cDims – 1].
    Cheers

    Steve

    ------------------

    Leave a comment:


  • Florent Heyworth
    replied
    Hi Steven

    I changed your code slightly to show how to put elements
    of VARIANT types in a SAFEARRAY as well as BSTR types in a
    SAFEARRAY:

    Code:
    #INCLUDE "win32api.inc"
    ' Example for SafeArrays
    ' --------------------------------------------------------
    %VT_EMPTY=0
    %VT_NULL=1
    %VT_I2=2
    %VT_I4=3
    %VT_R4=4
    %VT_R8=5
    %VT_CY=6
    %VT_DATE=7
    %VT_BSTR=8
    %VT_DISPATCH=9
    %VT_ERROR=10
    %VT_BOOL=11
    %VT_VARIANT=12
    %VT_UNKNOWN=13
    %VT_DECIMAL=14
    %VT_I1=16
    %VT_UI1=17
    %VT_UI2=18
    %VT_UI4=19
    %VT_I8=20
    %VT_UI8=21
    %VT_INT=22
    %VT_UINT=23
    %VT_VOID=24
    %VT_HRESULT=25
    %VT_PTR=26
    %VT_SAFEARRAY=27
    %VT_CARRAY=28
    %VT_USERDEFINED=29
    %VT_LPSTR=30
    %VT_LPWSTR=31
    %VT_FILETIME=64
    %VT_BLOB=65
    %VT_STREAM=66
    %VT_STORAGE=67
    %VT_STREAMED_OBJECT=68
    %VT_STORED_OBJECT=69
    %VT_BLOB_OBJECT=70
    %VT_CF=71
    %VT_CLSID=72
    %VT_VECTOR=&H1000
    %VT_ARRAY=&H2000
    %VT_BYREF=&H4000
     
    UNION VARIANTVALUE
      lVal          AS LONG
      bVal          AS BYTE
      iVal          AS INTEGER
      fltVal        AS SINGLE
      dblVal        AS DOUBLE
      boolVal       AS WORD
      scode         AS DWORD
      cyVal         AS CUR
      date          AS SINGLE
      bstrVal       AS DWORD
      punkVal       AS DWORD
      pdispVal      AS DWORD
      parray        AS DWORD
      pbVal         AS BYTE PTR
      piVal         AS INTEGER PTR
      plVal         AS LONG PTR
      pfltVal       AS SINGLE PTR
      pdblVal       AS DOUBLE PTR
      pboolVal      AS WORD PTR
      pscode        AS DWORD PTR
      pcyVal        AS CUR PTR
      pdate         AS SINGLE PTR
      pbstrVal      AS DWORD PTR
      ppunkVal      AS DWORD PTR
      ppdispVal     AS DWORD PTR
      pbyref        AS BYTE  PTR
      cVal          AS BYTE
      uiVal         AS WORD
      ulVal         AS DWORD
      intVal        AS LONG
      uintVal       AS DWORD
      pcVal         AS BYTE PTR
      puiVal        AS WORD PTR
      pulVal        AS DWORD PTR
      pintVal       AS LONG PTR
      puintVal      AS DWORD PTR
    END UNION
     
    TYPE VARIANT
      vt         AS WORD
      wReserved1 AS WORD
      wReserved2 AS WORD
      wReserved3 AS WORD
      Value      AS VARIANTVALUE
    END TYPE
     
    TYPE SAFEARRAYBOUND
      cElements AS DWORD
      lLbound   AS LONG
    END TYPE
     
    TYPE SAFEARRAY
      cDims      AS WORD
      fFeatures  AS WORD
      cbElements AS DWORD
      cLocks     AS DWORD
      pvData     AS DWORD
      rgsabound(0 TO 1) AS SAFEARRAYBOUND
    END TYPE
     
    TYPE DISPPARAMS
        rgvarg            AS LONG
        rgdispidNamedArgs AS LONG
        cArgs             AS DWORD
        cNamedArgs        AS DWORD
    END TYPE
     
    DECLARE FUNCTION VariantChangeType LIB "oleaut32.DLL" ALIAS "VariantChangeType" (BYREF pvargDest AS VARIANT,BYREF pvargSrc AS VARIANT,BYVAL wFlags AS WORD,BYVAL vtNew AS WORD) AS DWORD
    DECLARE FUNCTION VariantClear LIB "oleaut32.DLL" ALIAS "VariantClear" (BYREF pvarg AS VARIANT) AS DWORD
    DECLARE FUNCTION VariantCopy LIB "oleaut32.DLL" ALIAS "VariantCopy" (BYREF pvargDest AS VARIANT,BYREF pvargSrc AS VARIANT) AS DWORD
    DECLARE FUNCTION VariantCopyInd LIB "oleaut32.DLL" ALIAS "VariantCopyInd" (BYREF pvargDest AS VARIANT,BYREF pvargSrc AS VARIANT) AS DWORD
    DECLARE      SUB VariantInit LIB "oleaut32.DLL" ALIAS "VariantInit" (BYREF pvarg AS VARIANT)
     
    '
    ' BSTR API
    '
    '
    'It's easier to declare the SysAlloc* family to use ASCIIZ as the OLECHAR parameter
    DECLARE FUNCTION SysAllocString LIB "oleaut32.DLL" ALIAS "SysAllocString" ( szString AS ASCIIZ) AS DWORD
     
    DECLARE FUNCTION SysAllocStringLen LIB "oleaut32.DLL" ALIAS "SysAllocStringLen" (BYREF pOCH AS WORD,BYVAL cOCH AS DWORD) AS DWORD
    DECLARE      SUB SysFreeString LIB "oleaut32.DLL" ALIAS "SysFreeString" (BYVAL hBSTR AS DWORD)
    DECLARE FUNCTION SysReAllocString LIB "oleaut32.DLL" ALIAS "SysReAllocString" (BYREF hBSTR AS DWORD,BYREF pOleSZ AS WORD) AS WORD
    DECLARE FUNCTION SysReAllocStringLen LIB "oleaut32.DLL" ALIAS "SysReAllocStringLen" (BYREF hBSTR AS DWORD,BYREF pOCH AS WORD,BYVAL cOCH AS DWORD) AS WORD
    DECLARE FUNCTION SysStringLen LIB "oleaut32.DLL" ALIAS "SysStringLen" (BYVAL hBSTR AS DWORD) AS DWORD
    
    '
    ' SAFEARRAY API
    '
     
    DECLARE FUNCTION SafeArrayCreate LIB "oleaut32.DLL" ALIAS "SafeArrayCreate"(BYVAL vt AS WORD,BYVAL cDims AS DWORD,BYREF rgsabounds AS SAFEARRAYBOUND) AS DWORD
    DECLARE FUNCTION SafeArrayDestroy LIB "oleaut32.DLL" ALIAS "SafeArrayDestroy"(BYVAL hsa AS DWORD) AS DWORD
    DECLARE FUNCTION SafeArrayGetDim LIB "oleaut32.DLL" ALIAS "SafeArrayGetDim"(BYVAL hsa AS DWORD) AS DWORD
    DECLARE FUNCTION SafeArrayGetLBound LIB "oleaut32.DLL" ALIAS "SafeArrayGetLBound"(BYVAL hsa AS DWORD,BYVAL nDim AS DWORD,BYREF plLbound AS LONG) AS DWORD
    DECLARE FUNCTION SafeArrayGetUBound LIB "oleaut32.DLL" ALIAS "SafeArrayGetUBound"(BYVAL hsa AS DWORD,BYVAL nDim AS DWORD,BYREF plUbound AS LONG) AS DWORD
    DECLARE FUNCTION SafeArrayGetElemsize LIB "oleaut32.DLL" ALIAS "SafeArrayGetElemsize"(BYVAL hsa AS DWORD) AS DWORD
    DECLARE FUNCTION SafeArrayPutElement LIB "oleaut32.DLL" ALIAS "SafeArrayPutElement"(BYVAL hsa AS DWORD,BYREF rgIndices AS LONG,BYVAL pvData AS DWORD) AS DWORD
    DECLARE FUNCTION SafeArrayGetElement LIB "oleaut32.DLL" ALIAS "SafeArrayGetElement"(BYVAL hsa AS DWORD,BYREF rgIndices AS LONG,BYVAL pvData AS DWORD) AS DWORD
    DECLARE FUNCTION SafeArrayLock LIB "oleaut32.DLL" ALIAS "SafeArrayLock"(BYVAL hsa AS DWORD) AS DWORD
    DECLARE FUNCTION SafeArrayUnlock LIB "oleaut32.DLL" ALIAS "SafeArrayUnlock"(BYVAL hsa AS DWORD) AS DWORD
    DECLARE FUNCTION SafeArrayCopy LIB "oleaut32.DLL" ALIAS "SafeArrayCopy"(BYVAL hsa AS DWORD,BYREF phsaOut AS DWORD) AS DWORD
    DECLARE FUNCTION SafeArrayRedim LIB "oleaut32.DLL" ALIAS "SafeArrayRedim"(BYVAL hsa AS DWORD,BYREF psaboundNew AS SAFEARRAYBOUND) AS DWORD
    
     
    FUNCTION UnicodeToStr(BYVAL dw AS DWORD) AS STRING
      LOCAL Buffer AS STRING
      LOCAL length AS LONG
     
      length = SysStringLen(dw)
      Buffer = SPACE$(length)
      WideCharToMultiByte 0, _                     ' code page
                          %NULL, _                 ' performance and mapping flags
                          BYVAL dw, _              ' Unicode string to convert
                          -1, _              ' len of Unicode string
                          BYVAL STRPTR(Buffer), _  ' buffer for ANSI string
                          LEN(Buffer), _           ' len of ANSI buffer
                          BYVAL %NULL, _           ' unmappable chars buffer
                          BYVAL %NULL              ' unmappable chars flag
     
      FUNCTION = Buffer
     
    END FUNCTION
     
    FUNCTION StrToUnicode(BYVAL x AS STRING) AS STRING
     
      LOCAL Buffer AS STRING
     
      Buffer = SPACE$(LEN(x) * 2)
     
      MultiByteToWideChar 0, _                     ' code page
                          %NULL, _                 ' performance and mapping flags
                          BYVAL STRPTR(x), _       ' ANSI string to convert
                          -1, _                ' len of ANSI string
                          BYVAL STRPTR(Buffer), _  ' buffer for Unicode string
                          LEN(Buffer)              ' len of Unicode buffer
     
      FUNCTION = Buffer + CHR$(0,0)
     
    END FUNCTION
     
    FUNCTION SafeBstrArray( BYVAL s AS STRING ) AS STRING
        DIM x AS LONG
        DIM dwStringPtr AS DWORD
        DIM psa              AS DWORD
        DIM SafeArrayBoundDt AS SafeArrayBound
     
        SafeArrayBoundDt.lLBound = 0
        SafeArrayBoundDt.cElements = 100
     
        'When declared as VT_BSTR safearray members must be VT_BSTR
        psa = SafeArrayCreate(%VT_BSTR, 1, SafeArrayBoundDt)
        IF psa = 0 THEN
           PRINT "Error creating SafeArray."
        ELSE
           PRINT "Successfully created SafeArray."
        END IF
     
        x = 0
     
        'rgindices is decalred BYREF in your code - just use the variable....
        CALL SafeArrayPutElement(psa, x, SysAllocString( StrToUnicode(s) ) )
     
        CALL SafeArrayGetElement(psa, x, VARPTR(dwStringPtr) )
     
        FUNCTION =  UnicodeToStr( dwStringPtr )
        CALL SafeArrayDestroy(psa)
     
    END FUNCTION
     
    FUNCTION SafeVariantArray( BYVAL s AS STRING ) AS STRING
        DIM x  AS LONG
        DIM Var              AS VARIANT
        DIM Var2 AS VARIANT
        DIM retVal           AS LONG
        DIM Dispparam        AS DISPPARAMS
        DIM psa              AS DWORD
        DIM SafeArrayBoundDt AS SafeArrayBound
     
        SafeArrayBoundDt.lLBound = 0
        SafeArrayBoundDt.cElements = 100
     
        'When declared as VT_VARIANT safearray members must be VARIANTS
        psa = SafeArrayCreate(%VT_VARIANT, 1, SafeArrayBoundDt)
     
        CALL VariantInit(Var)
     
        IF psa = 0 THEN
           PRINT "Error creating SafeArray."
        ELSE
           PRINT "Successfully created SafeArray."
        END IF
     
        x = 0
     
        CALL VariantInit( Var )
        Var.VT            = %VT_BSTR
        Var.Value.bStrVal = SysAllocString( StrToUnicode(s) )
     
        'rgindices is decalred BYREF in your code - just use the variable....
        CALL SafeArrayPutElement(psa, x, VARPTR(Var))
     
        CALL VariantInit(Var2)
        CALL SafeArrayGetElement(psa, x, VARPTR(Var2))
     
        FUNCTION =  UnicodeToStr( Var2.Value.bStrVal )
        CALL VariantClear( Var )
    
        CALL SafeArrayDestroy(psa)
     
    END FUNCTION
     
    FUNCTION PBMAIN() AS LONG
     
        PRINT "VARIANT SAFEARRAY OF BSTR: " + SafeVariantArray( "Hello World" )
         
        PRINT "SAFEARRAY OF BSTR: " + SafeBstrArray( "Goodbye World" )
     
        WAITKEY$
    END FUNCTION
    Cheers

    Florent

    ------------------


    [This message has been edited by Florent Heyworth (edited July 26, 2001).]

    Leave a comment:


  • Steven Pringels 3
    replied
    Hi,

    Well I think that the problem is in the declaration:

    Code:
    DECLARE FUNCTION SafeArrayPutElement LIB "oleaut32.DLL" ALIAS "SafeArrayPutElement"(BYVAL hsa AS DWORD,BYREF rgIndices AS LONG,BYVAL pvData AS DWORD) AS DWORD
    DECLARE FUNCTION SafeArrayGetElement LIB "oleaut32.DLL" ALIAS "SafeArrayGetElement"(BYVAL hsa AS DWORD,BYREF rgIndices AS LONG,BYVAL pvData AS DWORD) AS DWORD
    Should be
    Code:
    DECLARE FUNCTION SafeArrayPutElement LIB "oleaut32.DLL" ALIAS "SafeArrayPutElement"(BYVAL hsa AS DWORD,BYVAL rgIndices AS LONG,BYVAL pvData AS DWORD) AS DWORD
    DECLARE FUNCTION SafeArrayGetElement LIB "oleaut32.DLL" ALIAS "SafeArrayGetElement"(BYVAL hsa AS DWORD,BYVAL rgIndices AS LONG,BYVAL pvData AS DWORD) AS DWORD
    hence we could do:

    Code:
        Dim x(0:1)  As Long
        Dim xPtr    As Long PTR
    
        x(0)              = 0
        xPtr              = VarPtr(x(0))
        Var.VT            = %VT_BSTR
        Var.Value.bStrVal = sgAllocString("Hello")
        Print SafeArrayPutElement(psa, xPtr, VarPtr(Var))
    This works

    ------------------

    Leave a comment:


  • Steven Pringels 3
    replied
    I'm lost...

    Just for giggles I replaced the code

    Code:
      Print SafeArrayPutElement(psa, xPtr, VarPtr(Var))
    with
    Code:
      Print SafeArrayPutElement(psa, 0, VarPtr(Var))
    So the pointer got replaced by the 0 which should be the 1st
    item in the array however this can be OK for a one dimensional
    array but how do you address a 2 dimensional array ? Strangly
    enough the function succeeds.



    ------------------

    Leave a comment:


  • Steven Pringels 3
    replied
    Hi Florent,

    Well, I put this together in a hurry. I'm doing something
    wrong but what

    Code:
    ' Example for SafeArrays
    ' --------------------------------------------------------
    %VT_EMPTY=0
    %VT_NULL=1
    %VT_I2=2
    %VT_I4=3
    %VT_R4=4
    %VT_R8=5
    %VT_CY=6
    %VT_DATE=7
    %VT_BSTR=8
    %VT_DISPATCH=9
    %VT_ERROR=10
    %VT_BOOL=11
    %VT_VARIANT=12
    %VT_UNKNOWN=13
    %VT_DECIMAL=14
    %VT_I1=16
    %VT_UI1=17
    %VT_UI2=18
    %VT_UI4=19
    %VT_I8=20
    %VT_UI8=21
    %VT_INT=22
    %VT_UINT=23
    %VT_VOID=24
    %VT_HRESULT=25
    %VT_PTR=26
    %VT_SAFEARRAY=27
    %VT_CARRAY=28
    %VT_USERDEFINED=29
    %VT_LPSTR=30
    %VT_LPWSTR=31
    %VT_FILETIME=64
    %VT_BLOB=65
    %VT_STREAM=66
    %VT_STORAGE=67
    %VT_STREAMED_OBJECT=68
    %VT_STORED_OBJECT=69
    %VT_BLOB_OBJECT=70
    %VT_CF=71
    %VT_CLSID=72
    %VT_VECTOR=&H1000
    %VT_ARRAY=&H2000
    %VT_BYREF=&H4000
    
    UNION VARIANTVALUE
      lVal          As Long
      bVal          As Byte
      iVal          As Integer
      fltVal        As Single
      dblVal        As Double
      boolVal       As Word
      scode         As Dword
      cyVal         As Cur
      date          As Single
      bstrVal       As Dword
      punkVal       As Dword
      pdispVal      As Dword
      parray        As Dword
      pbVal         As Byte PTR
      piVal         As Integer PTR
      plVal         As Long PTR
      pfltVal       As Single PTR
      pdblVal       As Double PTR
      pboolVal      As Word PTR
      pscode        As Dword PTR
      pcyVal        As Cur PTR
      pdate         As Single PTR
      pbstrVal      As Dword PTR
      ppunkVal      As Dword PTR
      ppdispVal     As Dword PTR
      pbyref        As Byte  PTR
      cVal          As Byte
      uiVal         As Word
      ulVal         As Dword
      intVal        As Long
      uintVal       As Dword
      pcVal         As Byte PTR
      puiVal        As Word PTR
      pulVal        As Dword PTR
      pintVal       As Long PTR
      puintVal      As Dword PTR
    END UNION
    
    TYPE VARIANT
      vt         AS WORD
      wReserved1 AS WORD
      wReserved2 AS WORD
      wReserved3 AS WORD
      Value      AS VARIANTVALUE
    END TYPE
    
    TYPE SAFEARRAYBOUND
      cElements AS DWORD
      lLbound   AS LONG
    END TYPE
    
    TYPE SAFEARRAY
      cDims      AS WORD
      fFeatures  AS WORD
      cbElements AS DWORD
      cLocks     AS DWORD
      pvData     AS DWORD
      rgsabound(0 to 1) AS SAFEARRAYBOUND
    END TYPE
    
    TYPE DISPPARAMS
        rgvarg            As Long
        rgdispidNamedArgs As Long
        cArgs             As Dword
        cNamedArgs        As Dword
    END TYPE
    
    DECLARE FUNCTION VariantChangeType LIB "oleaut32.DLL" ALIAS "VariantChangeType" (BYREF pvargDest AS VARIANT,BYREF pvargSrc AS VARIANT,BYVAL wFlags AS WORD,BYVAL vtNew AS WORD) AS DWORD
    DECLARE FUNCTION VariantClear LIB "oleaut32.DLL" ALIAS "VariantClear" (BYREF pvarg AS VARIANT) AS DWORD
    DECLARE FUNCTION VariantCopy LIB "oleaut32.DLL" ALIAS "VariantCopy" (BYREF pvargDest AS VARIANT,BYREF pvargSrc AS VARIANT) AS DWORD
    DECLARE FUNCTION VariantCopyInd LIB "oleaut32.DLL" ALIAS "VariantCopyInd" (BYREF pvargDest AS VARIANT,BYREF pvargSrc AS VARIANT) AS DWORD
    DECLARE      SUB VariantInit LIB "oleaut32.DLL" ALIAS "VariantInit" (BYREF pvarg AS VARIANT)
    
    '
    ' BSTR API
    '
    DECLARE FUNCTION SysAllocString LIB "oleaut32.DLL" ALIAS "SysAllocString" (BYREF pOleSZ AS WORD) AS DWORD
    DECLARE FUNCTION SysAllocStringLen LIB "oleaut32.DLL" ALIAS "SysAllocStringLen" (BYREF pOCH AS WORD,BYVAL cOCH AS DWORD) AS DWORD
    DECLARE      SUB SysFreeString LIB "oleaut32.DLL" ALIAS "SysFreeString" (BYVAL hBSTR AS DWORD)
    DECLARE FUNCTION SysReAllocString LIB "oleaut32.DLL" ALIAS "SysReAllocString" (BYREF hBSTR AS DWORD,BYREF pOleSZ AS WORD) AS WORD
    DECLARE FUNCTION SysReAllocStringLen LIB "oleaut32.DLL" ALIAS "SysReAllocStringLen" (BYREF hBSTR AS DWORD,BYREF pOCH AS WORD,BYVAL cOCH AS DWORD) AS WORD
    DECLARE FUNCTION SysStringLen LIB "oleaut32.DLL" ALIAS "SysStringLen" (BYVAL hBSTR AS DWORD) AS DWORD
    
    '
    ' SAFEARRAY API
    '
    
    DECLARE FUNCTION SafeArrayCreate LIB "oleaut32.DLL" ALIAS "SafeArrayCreate"(BYVAL vt AS WORD,BYVAL cDims AS DWORD,BYREF rgsabounds AS SAFEARRAYBOUND) AS DWORD
    DECLARE FUNCTION SafeArrayDestroy LIB "oleaut32.DLL" ALIAS "SafeArrayDestroy"(BYVAL hsa AS DWORD) AS DWORD
    DECLARE FUNCTION SafeArrayGetDim LIB "oleaut32.DLL" ALIAS "SafeArrayGetDim"(BYVAL hsa AS DWORD) AS DWORD
    DECLARE FUNCTION SafeArrayGetLBound LIB "oleaut32.DLL" ALIAS "SafeArrayGetLBound"(BYVAL hsa AS DWORD,BYVAL nDim AS DWORD,BYREF plLbound AS LONG) AS DWORD
    DECLARE FUNCTION SafeArrayGetUBound LIB "oleaut32.DLL" ALIAS "SafeArrayGetUBound"(BYVAL hsa AS DWORD,BYVAL nDim AS DWORD,BYREF plUbound AS LONG) AS DWORD
    DECLARE FUNCTION SafeArrayGetElemsize LIB "oleaut32.DLL" ALIAS "SafeArrayGetElemsize"(BYVAL hsa AS DWORD) AS DWORD
    DECLARE FUNCTION SafeArrayPutElement LIB "oleaut32.DLL" ALIAS "SafeArrayPutElement"(BYVAL hsa AS DWORD,BYREF rgIndices AS LONG,BYVAL pvData AS DWORD) AS DWORD
    DECLARE FUNCTION SafeArrayGetElement LIB "oleaut32.DLL" ALIAS "SafeArrayGetElement"(BYVAL hsa AS DWORD,BYREF rgIndices AS LONG,BYVAL pvData AS DWORD) AS DWORD
    DECLARE FUNCTION SafeArrayLock LIB "oleaut32.DLL" ALIAS "SafeArrayLock"(BYVAL hsa AS DWORD) AS DWORD
    DECLARE FUNCTION SafeArrayUnlock LIB "oleaut32.DLL" ALIAS "SafeArrayUnlock"(BYVAL hsa AS DWORD) AS DWORD
    DECLARE FUNCTION SafeArrayCopy LIB "oleaut32.DLL" ALIAS "SafeArrayCopy"(BYVAL hsa AS DWORD,BYREF phsaOut AS DWORD) AS DWORD
    DECLARE FUNCTION SafeArrayRedim LIB "oleaut32.DLL" ALIAS "SafeArrayRedim"(BYVAL hsa AS DWORD,BYREF psaboundNew AS SAFEARRAYBOUND) AS DWORD
    
    FUNCTION sgAllocString(pSz AS ASCIIZ) As Dword
    LOCAL hBstr    As Dword
    LOCAL StrLen   As Dword
    LOCAL pChar    As Byte PTR
    LOCAL i        As Dword
    DIM   OLEsz(1) As Word
      hbstr  = 0
      pChar  = VARPTR(pSz)
      StrLen = 0
      WHILE (@pchar <> 0)
        pchar  = pchar+1
        strlen = strlen+1
      WEND
    
      REDIM OLEsz(0 to strlen)
    
      pchar = VARPTR(pSZ)
      FOR i = 0 TO strlen
        OLEsz(i) = @pchar
        pchar   = pchar+1
      NEXT i
    
      hBstr=SysAllocString(OLEsz(0))
    
      sgAllocString=hbstr
    END FUNCTION
    
    Function pbMain() As Long
    
    Dim Var              As VARIANT
    Dim retVal           As LONG
    Dim Dispparam        As DISPPARAMS
    Dim psa              As Dword
    Dim SafeArrayBoundDt As SafeArrayBound
    
    
        SafeArrayBoundDt.lLBound = 0
        SafeArrayBoundDt.cElements = 100
    
        psa = SafeArrayCreate(%VT_BSTR, 1, SafeArrayBoundDt)
    
        Call VariantInit(Var)
    
        If psa = 0 Then
           Print "Error creating SafeArray."
        Else
           Print "Successfully created SafeArray."
        End If
    
        Dim x(0:1)  As Long
        Dim xPtr    As Long
    
        x(0) = 0
        xPtr = VarPtr(x(0))
    
        Var.VT            = %VT_BSTR
        Var.Value.bStrVal = sgAllocString("Hello")
     
        Print SafeArrayPutElement(psa, xPtr, VarPtr(Var))
    
        Print SafeArrayDestroy(psa)
    
    End Function
    ------------------

    Leave a comment:


  • Florent Heyworth
    replied
    Hi Steven

    can you post a compilable example of your code including the
    declares? The data assigned to the SAFEARRAY has to be a
    a VARIANT of type VT_BSTR. You must first init the variant
    by calling VariantInit and pass a Unicode string to the
    SysAllocString function which you then assign to the bStrVal
    member of the VARIANTDATA union.

    Cheers

    Florent

    ------------------

    Leave a comment:


  • Knuth Konrad
    replied
    steven,

    it's still there: http://www.powerbasic.com/support/pb...ead.php?t=4090

    i'm afraid i can't help you with that. i only used (and therefore know of) vpapi32.inc when passing arrays between vb and pb. maybe someone else can point you to the right direction.

    knuth

    ------------------
    http://www.softaware.de

    Leave a comment:


  • SafeArrayPutElement (Repost ! - who deleted previous ?)

    Hm...

    Don't know what to do. The SafeArrayPutElement doesn't seem to
    work for me. I have the following code

    Code:
      
        %VT_BSTR = 8
        Dim SafeArrayBoundDt As SAFEARRAYBOUND
    
        SafeArrayBoundDt.lLBound   = 0
        SafeArrayBoundDt.cElements = 100
    
        psa = SafeArrayCreate(%VT_BSTR, 1, SafeArrayBoundDt)
    
        If psa = 0 Then
           Print "Error creating SafeArray."
        Else
           Print "Successfully created SafeArray."
        End If
    
        Dim x(0:1)  As Long
        Dim xPtr    As Long   ' No pointer here - will be passed by reference.
        Dim Datastr As AsciiZ Ptr
        Dim TextStr As String
    
        x(0) = 0
        xPtr = VarPtr(x(0))
    
        TextStr = "Hello"
    
        DataStr = VarPtr(TextStr)
    
        Print SafeArrayPutElement(psa, xPtr, DataStr)
    Tried different variations with AsciiZ and String ptr but I get
    this strange result. It should print 0



    ------------------
Working...
X