Гергерт Сергей
Сущность
массивов в Visual Basic
Эта статья предполагает, что вы
знакомы с функциями Get/PutMem и принципом
получения параметров по их смещению с стеке (Подробнее...).
Все массивы в VB являются SAFEARRAY.
SAFEARRAY - это такая структура, которая описывает
размерности массива, тип содержащихся данных и
место, где эти данные находятся. Хранится всё это
тремя кусками:
- существует переменная длиной 4 байта,
содержащая адрес структуры SAFEARRAY (указатель
на указатель)
- существует сама структура SAFEARRAY (именно
по тому самому адресу), размер разный
- существуют данные массива (в третьем месте -
на него указывает член pvData структуры
SAFEARRAY).
Из этого описания уже видно,
что мы могли бы, к примеру, заимев указатель на
произвольные данные (апишка
1
какая-нибудь вернула, к примеру), записать его в
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 у вас появился?
1 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
Антон
Ермоленко
e-mail: aae-000@mail.ru