Эта статья предполагает, что вы знакомы с функциями Get/PutMem и принципом получения параметров по их смещению с стеке (Подробнее...).
Все массивы в VB являются SAFEARRAY. SAFEARRAY - это такая структура, которая описывает размерности массива, тип содержащихся данных и место, где эти данные находятся. Хранится всё это тремя кусками:

существует переменная длиной 4 байта, содержащая адрес структуры SAFEARRAY (указатель на указатель)
существует сама структура SAFEARRAY (именно по тому самому адресу), размер разный
существуют данные массива (в третьем месте - на него указывает член pvData структуры SAFEARRAY).

Из этого описания уже видно, что мы могли бы, к примеру, заимев указатель на произвольные данные (апишка¹ какая-нибудь вернула, к примеру), записать его в pvData (4 байта всего!) и таким образом получить готовый массив. Или могли бы сделать так, чтобы два массива ссылались на 1 участок данных. Или ещё чего - обязательно придёт в голову какое-нибудь применение, как столкнёшься с конкретной задачей.
Всё это, конечно, хорошо, но как получить указатель хоть на что-то, относящееся к самому массиву, а не к его данным? Если применить VarPtr к элементу массива, то получим указатель на данные, а получить из него указатель на структуру SAFEARRAY нельзя. А если укажем аргументом VarPtr сам массив, то получим ошибку компиляции. Но не всё так страшно. Делаем небольшую хитрость: переобъявляем функцию VarPtr под именем ArrPtr:

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

Вот, собственно, и всё. Вызываем эту функцию - и у нас в кармане не что-нибудь, а адрес указателя на SAFEARRAY - то есть самое начало этой цепочки!
После опубликования первого варианта этой статьи мне указали на одну досадную вещь. Дело в том, что при передаче строковых параметров в любую апишку VB автоматически создаёт null-terminated копию, и в апишку идёт указатель именно на копию. Следовательно, мы не сможем получить указатель на массив String - ведь ArrPtr объявлена через Declare, и VB обращается с ней соответственно. У меня даже руки опустились поначалу. Но всё-таки есть одна маленькая фишечка

Public Function StrArrPtr(arr() As String, Optional ByVal IgnoreMe As Long = 0) As 
Long
 GetMem4 VarPtr(IgnoreMe) - 4, VarPtr(StrArrPtr)
End Function

Второй параметр, как следует из названия, следует игнорировать
Начнём же прикладную часть.
Для начала напишем функцию, которая будет определять - а была ли присвоена размерность динамическому массиву, или он бесплотен? Помнится, на форуме всплывал этот вопрос. Решения найдено не было, сошлись на том, что придётся отлавливать ошибку. Принцип работы этой функции очень прост. Дело в том, что когда VB отводит память под адрес указателя на SAFEARRAY, то в последствии используется именно эта память и никакая другая - что бы вы ни делали с динамическим массивом, как бы вы его ни переопределяли или erase'или, - адрес указателя на SAFEARRAY есть величина постоянная (в то время как сама SAFEARRAY может скакать как угодно). Так вот, если массив не был определён, то адрес указателя содержит не адрес, а ноль. Ну а раз так, то:

Function ArrayExists(arr() As Long) As 
Long
 GetMem4 ArrPtr(arr), VarPtr(ArrayExists)
End Function

Обращаю внимание на одну досадную вещь. Не получится объявить функцию, принимающую массив любого типа. Поэтому придётся для каждого типа используемых данных писать свою функцию: ArrayExitsLong, ArrayExitsVariant, ArrayExitsMyUserType и т.д. Шаблонов-то нет у нас с вами, и перегрузки тоже Но будет меняться только название функции и тип параметра - тело функции остаётся неизменным.
Нихаласо? Хотим всё-таки универсальность? Ладно, но тогда функция будет

Function ArrayExists(byval ppArr As Long) As Long
 GetMem4 ppArr, VarPtr(ArrayExists)
End Function

А вызывать её тогда нужно не "flag = ArrayExists(arrName)", а "flag = ArrayExists(ArrPtr(arrName))".
Но я тут везде буду оперировать массивами Long, ладно?
Продолжим... Займёмся теперь... ну, допустим... созданием массивов с общими данными. Сделаем так: есть как бы главный массив, и есть два других, которые в нём полностью содержатся. Интересно, зачем это нужно? Ну а вдруг пригодится .
Объявим ещё пару функций:

Private Declare Sub SafeArrayAllocDescriptor Lib 
"oleaut32.dll" (ByVal cDims As Long, _
ppsaOut As Any)
Private Declare Sub SafeArrayDestroyDescriptor Lib "oleaut32.dll" (psa As Any)
Private arrMain() As Long, arr1() As Long, arr2() As Long
Private Sub Form_Load()
 Dim i As Long
 
 ReDim arrMain(1 To 10)
 
 'arr1 будет ссылаться на данные главного массива с 1 по 5
 CreateSAFEARRAY ArrPtr(arr1), 4, VarPtr(arrMain(1)), 1, 5
 
 'arr2 будет ссылаться на данные главного массива с 6 по 10
 'два последних параметра могут быть любыми - главное, чтобы
 'расстояние между ними было во столько элементов, сколь нужно.
 CreateSAFEARRAY ArrPtr(arr2), 4, VarPtr(arrMain(6)), 6, 10
 
 'Заполняем только основной массив:
 For i = 1 To 10
 arrMain(i) = i
 Next
 
 Me.AutoRedraw = True
 Me.Print "Основной массив:"
 For i = 1 To 10
 Me.Print arrMain(i)
 Next
 Me.Print
 
 Me.Print "Маленький 1:"
 For i = 1 To 5
 Me.Print arr1(i)
 Next
 Me.Print
 
 Me.Print "Маленький 2:"
 For i = 6 To 10
 Me.Print arr2(i)
 Next
 
End Sub
Private Function CreateSAFEARRAY(ByVal ppBlankArr As Long, ByVal ElemSize As _
Long, ByVal pData As Long, ParamArray Bounds()) As Long
 Dim p As Long, i As Long
 
 'ParamArray Bounds - это описание размерностей массива:
 'bounds(0) - нижняя граница первой размерности
 'bounds(1) - верхняя граница первой размерности
 'bounds(2) - нижняя граница второй размерности
 'bounds(3) - верхняя граница второй размерности и т.д.
 
 SafeArrayAllocDescriptor (UBound(Bounds) + 1) / 2, ByVal ppBlankArr
 
 GetMem4 ppBlankArr, VarPtr(p)
 PutMem4 p + 4, ElemSize
 PutMem4 p + 12, pData
 
 For i = 0 To UBound(Bounds) Step 2
 PutMem4 p + 16 + i * 4, Bounds(i + 1) - Bounds(i) + 1
 PutMem4 p + 20 + i * 4, Bounds(i)
 Next
End Function
Private Function DestroySAFEARRAY(ByVal ppArray As Long) As Long
 Dim p As Long
 
 GetMem4 ppArray, VarPtr(p)
 SafeArrayDestroyDescriptor ByVal p
 PutMem4 ppArray, 0
End Function
Private Sub Form_Unload(Cancel As Integer)
 DestroySAFEARRAY ArrPtr(arr1)
 DestroySAFEARRAY ArrPtr(arr2)
End Sub

Обратите внимание - созданные нами массивы нами же и уничтожаются. Это потому, что они ссылаются на один и тот же участок памяти, а мы не хотим три раза уничтожать один и тот же участок, тем более что после первого уничтожения в нём может оказаться уже что-то не наше. Так что мы просто уничтожаем дескрипторы дочерних массивов, не трогая данные. Данные уничтожит сам VB, вместе с arrMain.
Теперь функция, позволяющая иметь один массив в двух переменных.

Function Assign(byval ppArrSrc As Long,

ByVal ppBlankArr As Long) As Long GetMem4 ppArrSrc, ppArrBlankArr End Function

Это мы просто записали адрес на структуру в ppBlankArr. И теперь тот массив, ArrPtr которого был передан в качестве ppBlankArr, будет являться точной копией массива ppArrSrc - а ведь мы скопировали всего 4 байта! Уничтожаются такие клонированные массивы при помощи

Function DestroyAssigned(ByVal ppAssignedArr As

Long) As Long PutMem4 ppAssignedArr, 0 End Function

Может возникнуть вопрос - а откуда это такие циферки в PutMem4. Это следует из описания структуры SAFEARRAY - как же мы её-то не осветили ещё:

Private Type SAFEARRAYBOUND cElements As Long 'Количество элементов в размерности lLBound As Long 'Нижняя граница размерности End Type

Private Type SAFEARRAY cDims As Integer 'Число размерностей fFeatures As Integer 'Флаг, юзается функциями SafeArray cbElements As Long 'Размер одного элемента в байтах cLocks As Long 'Сколько раз массив был locked, но пока не unlocked. pvData As Long 'Указатель на данные. rgsabound As SAFEARRAYBOUND 'Повторяется для каждой размерности. End Type

Так что p + 4 - это cbElements, p + 12 - pvData, ну, вы поняли
Кстати, само описание структуры нам вроде как и не нужно Разве что для справки - какой мембер по какому оффсету. Да и то - написали один раз процедуру CreateSAFEARRAY и можно забыть даже про эти оффсеты. А всё для чего? А чтобы CopyMemory зазря не дёргать каждый раз И ещё потому, что структура имеет переменный размер - последний её член повторяется столько раз, сколько размерностей у массива. Подобная вольность в объявлении структур на VB не поощряется - нам придётся объявлять структурки для одной размерности, для двух, для трёх... А оно нам надо? Вот и даём размещение этой структуры на откуп функции SafeArrayAllocDescriptor.
Ну что, modSAFEARRAY у вас появился?

¹API функции (прим. редактора).

Комментарий к статье

Статья в целом неплохая. Однако, в неё вкралась досадная ошибка (приведённый в статье пример без устранения этой ошибки работать не будет): функция ArrPtr() возвращает не указатель на SAFEARRAY, а указатель на указатель на SAFEARRAY. Плюс, мне кажется, что работать используя структуру (тип) SAFEARRAY несомненно проще, чем описанным в статье способом, так как при этом нет нужды использовать функции ни SafeArrayAllocDescriptor(), ни SafeArrayDestroyDescriptor(). Достаточно объявить:

Dim Arr1() as [type name], SA1 as SAFEARRAY, Arr2() as [type name], SA2 as SAFEARRAY

Затем прописать в структурах SA1 и SA2 параметры (второй и четвёртый параметры в структурах SAFEARRAY должны быть установлены в 128 и 0 соответственно, остальное придумаете сами). После чего прописать на них указатели:

PutMem4 ArrPtr(Arr1), VarPtr(SA1)
PutMem4 ArrPtr(Arr2), VarPtr(SA2)

И всё. Конечно, при работе с массивами различной размерности «могут понадобиться» различные типы SAFEARRAY. Но это на самом деле ерунда, так как можно пойти совсем простым путём объявления переменной длины (например, строки):

'В функцию, «создающую SAFEARRAY», посылается StrPtr(StrAsSA)
Dim StrAsSA as String
StrAsSA=String(24+8*(NumbOfDims-1), 0)
StrAsSA=StrConv(StrAsSA, vbFromUnicode)
...
Dim SA as SAFEARRAY, SAB() as SAFEARRAYBOUND, i as Byte
ReDim SAB(2 to NumbOfDims)
'Заполняем SA и все SAB'ы, затем:
CopyMem StrPtr(StrAsSA), VarPtr(SA), 24
For i=2 to NumbOfDims
 CopyMem StrPtr(StrAsSA)+24+(i-2)*8, VarPtr(SAB(i)), 8
Next i

После чего прописываете значение StrPtr(StrAsSA) по адресу ArrPtr(Arr). Разумеется, массивы Arr1(), Arr2()… необходимо объявлять вместе с StrAsSA1, StrAsSA2.

Вместо функций VarPtr(), ArrPtr() и StrArrPtr() можно использовать одну из
двух (на выбор) следующих универсальных функций:

Public Function AnyPtr(ByRef vVar As Variant) As 
Long
CopyMem VarPtr(AnyPtr), VarPtr(vVar) + 1, 1
If AnyPtr = 64 Or AnyPtr = 96 Then CopyMem VarPtr(AnyPtr), 
VarPtr(vVar) +_
8, 4
End Function

Public Function AnyPtrEx(ByRef vVar As Variant, Optional 
ByRef vTypeName As_
String) As Long
Dim lVT As Long
FillMem VarPtr(lVT), 4, 0
CopyMem VarPtr(lVT), VarPtr(vVar) + 
1, 1
If lVT = 64 Or lVT = 96 Then
 CopyMem VarPtr(lVT), VarPtr(vVar) + 8, 4
Else
 lVT = 0
End 
If
AnyPtrEx = lVT
vTypeName = TypeName(vVar)
End Function

Дизайн и поддержка: Silicon Taiga

Обратиться по техническим вопросам