Announcement

Collapse
No announcement yet.

SafeArrayPutElement (Repost ! - who deleted previous ?)

Collapse
X
Collapse
 
  • Page of 1
  • Filter
  • Time
  • Show
Clear All
new posts
Previous template Next
  • 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:

  • Steven Pringels 3
    started a topic SafeArrayPutElement (Repost ! - who deleted previous ?)

    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



    ------------------
    Tags: None
Previous template Next
Working...
X

We process personal data about users of our site, through the use of cookies and other technologies, to deliver our services, and to analyze site activity. For additional details, refer to our Privacy Policy.

By clicking "I AGREE" below, you agree to our Privacy Policy and our personal data processing and cookie practices as described therein. You also acknowledge that this forum may be hosted outside your country and you consent to the collection, storage, and processing of your data in the country where this forum is hosted.

I Agree