COM: VBA to VB (SafeArray related question)

[Yuri_D]

Hello!

Can you help me to translate this VBA code to PB please?

Code: Select all

Function FieldType(obj As Object, label As String) As String
    FieldType = "string" 'default
    Dim f As Integer
    For f = LBound(obj.fields) To UBound(obj.fields)
      Dim lc: lc = LCase(label)
        If (lc = LCase(obj.fields(f).label) Or lc = LCase(obj.fields(f).name)) Then
            FieldType = obj.fields(f).Type
            Exit For
        End If
    Next f
'  5.05  If (FieldType = "") Then
'        Error "invalid label -->" & label
'    End If
End Function

When I'm using a SafeArray for obj.Fields it returns only the field Values but it contains field Labels, Names Types etc. which I need to retrieve.

[Yuri_D]

Nobody knows?
Looks like this Safearray is uni-dimensional, each element has \vt = 9 (Dispatch) and being converted by VT_STR(*Var.Variant) it returns the \Value parameter but Excel can return \Name, \Label and \Type as well.
No idea how to do the same on PB...

[mk-soft]

Show to SafeArray...

Perhaps help this... Link: viewtopic.php?f=14&t=40150

[Yuri_D]

Hi mk-soft,
Thanks, I'm using this add-in but it doesn't help in this case(
I think that iDispatch can point to another array but I have no enough knowledge to proof it and to extract the data

[skywalk]

light reading on VB6 Safe Array and other stuff

[Yuri_D]

Hi skywalk,

Thanks, I learned a little bit more and now at least I understand the meaning of fields
* SafeArray *
cDim: 1
cbElements: 16
* rgsabound *
cElements: 78
lLbound: 0

But the problem is that it is an array of objects... and here I'm losing the way
I tried to wrap it by COMate_WrapCOMObject() but COMate crashes on this so looks I do something wrong... totally...

[mk-soft]

I think the Object its Array Of Variant

Code: Select all

; Not Test

CompilerIf Defined(pData, #PB_Structure) = 0
  Structure pData
    StructureUnion
      llVal.q[0]
      lVal.l[0]
      bVal.b[0]
      iVal.w[0]
      fltVal.f[0]
      dblVal.d[0]
      boolVal.w[0]
      bool.w[0]
      scode.l[0]
      cyVal.l[0]
      date.d[0]
      bstrVal.i[0]
      varVal.VARIANT[0] ; Added ?
      Value.VARIANT[0] ; Added ?
      *punkVal.IUnknown[0]
      *pdispVal.IDispatch[0]
      *parray[0]
      *pbVal.BYTE[0]
      *piVal.WORD[0]
      *plVal.LONG[0]
      *pllVal.QUAD[0]
      *pfltVal.FLOAT[0]
      *pdblVal.DOUBLE[0]
      *pboolVal.LONG[0]
      *pbool.LONG[0]
      *pscode.LONG[0]
      *pcyVal.LONG[0]
      *pdate.DOUBLE[0]
      *pbstrVal.INTEGER[0]
      *ppunkVal.INTEGER[0]
      *ppdispVal.INTEGER[0]
      *pparray.INTEGER[0]
      *pvarVal.VARIANT[0]
      *byref[0]
      cVal.b[0]
      uiVal.w[0]
      ulVal.l[0]
      ullVal.q[0]
      intVal.l[0]
      uintVal.l[0]
      *pdecVal.LONG[0]
      *pcVal.BYTE[0]
      *puiVal.WORD[0]
      *pulVal.LONG[0]
      *pullVal.QUAD[0]
      *pintVal.LONG[0]
      *puintVal.LONG[0]
      decVal.l[0]
      brecord.VARIANT_BRECORD[0]
    EndStructureUnion
  EndStructure
CompilerEndIf

Global.variant var.Variant, *obj
Global *psa.SAFEARRAY

*obj = var
If *obj\vt = (#VT_ARRAY | #VT_VARIANT)
  Debug "Is Array of Variant"
  *psa = *obj\parray
  For i = 0 To *psa\dummyrgsabound\cElements - 1
    If *psa\pvData\Value[i]\vt = #VT_DISPATCH
      Debug "Is Field Object"
      *Field.IDispatch = *psa\pvData\Value[i]\pdispVal
    EndIf
  Next
EndIf

[Yuri_D]

Hi mk-soft,

So many rows of code and only one which solved my problem))

Protected.i _iEntity, _iLBound, _iUBound
Protected.COMateObject _objField
Protected.SAFEARRAY *saEntity
Protected.IDispatch *idField

*saEntity = VT_ARRAY( _obj\GetVariantProperty( "Fields")) ; "Fields" VARIANT type: VT_ARRAY | VT_VARIANT
_iLBound = saLBound( *saEntity)
_iUBound = saUBound( *saEntity)

For _iEntity = _iLBound To _iUBound

*idField = *saEntity\pvData\Value[_iEntity]\pdispVal

_objField = COMate_WrapCOMObject( *idField)
If _objField
Debug _objField\GetStringProperty( "Name")
Debug _objField\GetStringProperty( "Value")
Debug _objField\GetStringProperty( "Type")
_objField\Release()
EndIf
Next
saFreeSafeArray( *saEntity)

Thank you so much!