Option Explicit

 

'SAFEARRAY** (указатель на указатель на SAFEARRAY, для всех типов кроме String)

Private Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (Arr() As Any) As Long

'Аналог RtlMoveMemory на 4 байта

Private Declare Function GetMem4 Lib "msvbvm60" (ByVal pSrc As Long, ByVal pDst As Long) As Long

'Копирование участка памяти (что не очевидно из названия функции :) )

Private Declare Sub RtlMoveMemory Lib "kernel32" (ByVal Destination As Any, ByVal Source As Any, ByVal Length As Long)

 

Private StringArray() As String

Private LongArray() As Long

Private DoubleArray() As Double

 

Private Sub Form_Load()

    ReDim LongArray(255) As Long

    MsgBox ArrayExists(StrArrPtr(StringArray)) & vbTab & ArrayExists(ArrPtr(LongArray)) & _

        vbTab & ArrayExists(ArrPtr(DoubleArray))

End Sub

 

'SAFEARRAY* (указатель на SAFEARRAY)

Private Function ArrayExists(ByVal ArrPt As Long) As Long

    GetMem4 ArrPt, VarPtr(ArrayExists)

End Function

 

'SAFEARRAY** (для массива типа String)

Private Function StrArrPtr(ByRef Arr() As String, Optional ByVal IgnoreMe As Long = 0) As Long

    GetMem4 VarPtr(IgnoreMe) - 4, VarPtr(StrArrPtr)

End Function

 

'Универсальная функция получения указателя

'Можно использовать вместо VarPtr, ArrPtr, StrArrPtr

'А так же для 'User-defined type' массивов

Public Function AnyPtr(ByRef Var As Variant) As Long

    RtlMoveMemory VarPtr(AnyPtr), VarPtr(Var) + 1, 1

    If AnyPtr = 64 Or AnyPtr = 96 Then

        RtlMoveMemory VarPtr(AnyPtr), VarPtr(Var) + 8, 4

    End If

End Function