Динамическое построение структур в памяти

[ALX_2002]

Доброго дня товарищи. Ковыряю библиотеку PKCS11. Возникла проблема с динамической генерацией структуры шаблона поиска.

Мне необходимо динамически формировать массив вот таких структур, заполнить их значениями и указателями на данные, а затем передавать указатель на него Сишной функции C_FindObjectsInit.

Код: Выделить всё

typedef struct CK_ATTRIBUTE { 
   CK_ATTRIBUTE_TYPE type; 
   CK_VOID_PTR pValue; 
   CK_ULONG ulValueLen;
} CK_ATTRIBUTE;


Саму структуру в VB-ый вид я преобразовал:

Код: Выделить всё

Public Type CK_ATTRIBUTE
    lType As Long
    lValue As Long
    lValueLen As Long '  '/* in bytes' */
End Type


Казалось бы дальше достаточно сделать:

Код: Выделить всё

Dim aTemplate(3) as CK_ATTRIBUTE


и вроде бы всё отлично. Но беда в том, что в этих структурах нужно ещё заполнить все 3 элемента
type - Long значение атрибута (1,2,3,4 и т.п),
pValue - Long указатель на данные
pValueLen - Long значение размера хранимых данных по указанному выше адресу

Таким образом структура атрибута может ссылаться на любой тип данных: строку, число, байтовый массив.

Мне нужно сделать нечто типа Class обёртки для динамического построения этого шаблона.

Подумав, предположил что необходим метод SetAttribute(ByVal AttributeType, AttributeValue as Variant).

Бодро начал заполнять коллекцию значениями, чтобы потом через VarPtr и StrPtr подсунуть указатели на них в структуры. Уже и код написал.

Код: Выделить всё

....
.aTemplate(i).lValue = VarPtr(oColl(i))
...


Ан не работает. Поскрипев мозгами сообразил, что так я получаю указатель на временный буфер и логично что так работать не будет. Т.к он очищается.

В общем тупиковая ситуация. Знаний не хватает, чтоб с этим справиться. Понимаю, что объяснил сумбурно, поэтому если кто-то готов помочь, буду рад пояснить в чём проблема более подробно...

P.S Пока пришёл к выводу, что нужно создавать отдельный Byte() массив, в него копировать все значения атрибутов друг за другом, а в структуры передавать указатель на начало и длину данных внутри этого массива, т.к не представляю как сослаться через VarPtr / StrPtr на данные внутри коллекции..

[Хакер]

P.S Пока пришёл к выводу, что нужно создавать отдельный Byte() массив, в него копировать все значения атрибутов друг за другом, а в структуры передавать указатель на начало и длину данных внутри этого массива,

1. Да.
2. Но необязательно «друг за другом». Можно в любом порядке. Можно с дырками. Лучше именно с дырками с выравниванием по хорошей границе.
3. Но можно и не байтовый массив, а массив Variant-ов.

Проблема решена, я так понимаю? Если нет, то в чём проблема?

[ALX_2002]

Хакер , теперь я ещё более озадачен. Появилось больше вопросов. Наверное пояснил некорректно.

Проблема в организации динамического построителя структуры.

В статике всё просто:

Код: Выделить всё

'Описание структуры
Private Type CK_ATTRIBUTE
    lType As Long
    lValue As Long
    lValueLen As Long '  '/* in bytes' */
End Type

'Создание массива структур
Dim aTemplate(1 To 3) As CK_ATTRIBUTE

Private Sub Form_Load()
    'Объявление буферов для значений атрибутов
    Dim AttributeValue1 As Long
    Dim AttributeValue2 As String
    Dim AttributeValue3() As Byte
   
    'Заполнение первого атрибута
    AttributeValue1 = 100
    With aTemplate(1)
        .lType = 7
        .lValue = VarPtr(AttributeValue1)
        .lValueLen = LenB(AttributeValue1)
    End With

    'Заполнение второго атрибута
    AttributeValue2 = "test"
    With aTemplate(2)
        .lType = 4
        .lValue = StrPtr(AttributeValue2)
        .lValueLen = LenB(AttributeValue2)
    End With

    'Заполнение третьего атрибута
    AttributeValue3 = "test"
    With aTemplate(3)
        .lType = 5
        .lValue = VarPtr(AttributeValue3(LBound(AttributeValue3)))
        .lValueLen = UBound(AttributeValue3)
    End With
   
    'Получение указателя на структуру
    MsgBox VarPtr(aTemplate(1))
End Sub


Сложность возникла с динамическим формированием. Когда заранее неизвестно сколько атрибутов будет. Соответственно нужен какой-то механизм (метод), который на основании полученных данных формировал данные для структуры.

Пытаюсь сотворить объектную оболочку, которая имела бы:
1) метод добавления атрибутов SetAttribute(ByVal AttributeType as Long, AttributeValue as Variant)
2) метод удаления атрибутов RemoveAttribute(ByVal AttributeType)
3) Функцию построения сишной структуры и возврата указателя на неё (на структуру), дабы скормить его (указатель) уже функции библиотеки. GetStructPointer()

Т.к AttributeType (тип атрибута) может принимать только значения типа Long, то с ним проблем нет. А вот AttributeValue (значение атрибута) может быть и числовым и текстовым и байтовым массивом. Вопрос - Как и во что сложить данные переданные через AttributeValue ?, чтобы потом на них можно было сослаться через VarPtr / StrPtr в созданной структуре.

[ALX_2002]

В итоге :

1) Создать динамически массив элементов CK_ATTRIBUTE на нужное кол-во элементов могу.

Код: Выделить всё

ReDim aTemplates(1 to Count) as CK_ATTRIBUTE

2) Не знаю как наиболее правильно сложить переданные в класс модуль данные, так чтобы сослаться на них в поля lValue элементов массива.

Более наглядно:

Код: Выделить всё

aTemplate(i).lValue = VarPtr(???)


Т.к на входе я получаю значения типа Variant.

3) Правильным ли будет решение - размещение всех данных AttributeValue друг за другом в непрерывном byte() массиве и передача ссылок на нужные области в структуры ?

[Хакер]

метод добавления атрибутов SetAttribute(ByVal AttributeType as Long, AttributeValue as Variant)

Почему Set а не Add? Это осознанный намёк на то, что повторный вызов с тем же AttributeType должен заменять, а не добавлять элемент цепочку?

Опиши более подробно, что должен отождествлять экземпляр класса, который ты хочешь сделать. {Один экземпляр = один элемент цепочки аргуменов} или {Один экземпляр = цепочка из одного или более аргументов}? Судя по методам, всё же второе.

Расскажи о том, важен ли порядок следования элементов-аргументов в цепочке? Нужна ли возможность переупорядочивания?

Какой предполагаемый жизненный цикл экземпляра класса, который ты хочешь реализовать?

А вот AttributeValue (значение атрибута) может быть и числовым и текстовым и байтовым массивом. Вопрос - Как и во что сложить данные переданные через AttributeValue ?, чтобы потом на них можно было сослаться через VarPtr / StrPtr в созданной структуре.

Уже было сказано. И вообще ответ — куда угодно.
Можно иметь один байтовый массив и записывать туда всё.
Можно иметь отдельный массив для чисел, отдельный массив для строк, отдельный массив для BLOB-ов.
Можно иметь один массив с элементами типа Variant, элементы которого и будут постоянными «держателями» данных.
Можно иметь не массив, а просто буфер в памяти, выделенный с помощью HeapAlloc/VirtualAlloc/ещё-какой-нибудь-функции-выделения-памяти.

Код: Выделить всё

Более наглядно:
[code]    aTemplate(i).lValue = VarPtr(???)[/code]

В зависимости от выбора решения из перечисленных выше. Для байтового массива, например: VarPtr(buffer_array(cur_elm_offset))

3) Правильным ли будет решение - размещение всех данных AttributeValue друг за другом в непрерывном byte() массиве и передача ссылок на нужные области в структуры ?

Оно не неправильное. Значит допустимое.
Располагать элементы впритык, как я уже писал выше, — не хорошо. Нужно выравнивать начала элементов. Но это не кринимиально для x86, а для других архитектур VB6 не производит код (на данный момент времени).
Должен ли это быть непрерывный массив или это могут быть несколько байтовых массивов? Нет ничего плохого в том, чтобы иметь один массив, до тех пор, пока не станет вопрос о необходимости удаления элементов из середины, добавления в сердину, перестановки элементов.
Должен ли это быть именно массив байтов? Никто никому ничего не должен. Вызываемой стороне плевать.

[Хакер]

Отдельного внимания заслуживает вопрос о том, в каком формате/виде/кодировке ожидает вызываемая библиотека получать строки.

[ALX_2002]

Хакер, Вы как всегда проницательны до телепатии ! .

Почему Set а не Add?

Действительно, SetAttribute подразумевает замену атрибута, если таковой имеется. Поэтому я и думал в сторону использования коллекции как хранилища. Ведь у неё уже реализованы механизмы проверки наличия элемента по ключу.

{Один экземпляр = один элемент цепочки аргуменов} или {Один экземпляр = цепочка из одного или более аргументов} ?

Тоже задавался этим вопросом. В принципе и та и другая реализация мне подходит, но больше склоняюсь ко второй. Эти структуры передаются в разные функции библиотеки. И где-то достаточно структуры из одного атрибута, а где-то с десяток нужно задавать. Так что логично, что массив не всегда нужен, а иногда достаточно просто указателя на единственную структуру CK_ATTRIBUTE.
Но склоняюсь ко второму методу, т.к мне кажется он более универсальный. Возможно ошибаюсь.

Расскажи о том, важен ли порядок следования элементов-аргументов в цепочке? Нужна ли возможность переупорядочивания?

Нет, порядок абсолютно не важен и в переупорядочивании тоже необходимости нет. Единственное от чего хотел избавиться это дублирование атрибутов.

Какой предполагаемый жизненный цикл экземпляра класса, который ты хочешь реализовать?

В принципе мне надо, чтобы структура, созданная внутри класса, существовала до тех пор пока существует класс. Т.е последовательность такая:
1) Создал класс
2) Заполнил атрибуты через SetAttribute
3) Получил ссылку на созданную структуру и передал её функции библиотеки.
4) А дальше принимать решение об уничтожении класса, а следовательно и данных внутри него.

Т.е необходимо, чтобы данные, на которые ссылаются поля структуры, в момент вызова функции существовали, а дальше уже по обстановке.

Уже было сказано. И вообще ответ — куда угодно.
Можно иметь один байтовый массив и записывать туда всё.
Можно иметь отдельный массив для чисел, отдельный массив для строк, отдельный массив для BLOB-ов.
Можно иметь один массив с элементами типа Variant, элементы которого и будут постоянными «держателями» данных.
Можно иметь не массив, а просто буфер в памяти, выделенный с помощью HeapAlloc/VirtualAlloc/ещё-какой-нибудь-функции-выделения-памяти.

Понял. Тогда прошу Вашей рекомендации в этом вопросе. Что наиболее предпочтительно на Ваш взгляд в этой ситуации (компромисс между удобством, скоростью, минимумом кода) ?
Смысл предложенных вариантов вроде бы понял, но не совсем понимаю как при этом правильно организовать замену атрибута по ключу ? При добавлении прогонять цикл перебора и искать совпадение или туплю ?

Нет ничего плохого в том, чтобы иметь один массив, до тех пор, пока не станет вопрос о необходимости удаления элементов из середины, добавления в сердину, перестановки элементов.
Должен ли это быть именно массив байтов? Никто никому ничего не должен. Вызываемой стороне плевать.

Вот как раз реализация возможности замены значения атрибута и ставит меня в тупик. Не знаю как это правильно написать.

Отдельного внимания заслуживает вопрос о том, в каком формате/виде/кодировке ожидает вызываемая библиотека получать строки.

Я скармливал ей двухбайтовый юникод. Так как функции библиотеки никак не анализируют значение внутри, то и кодировка получается им не столь важна.

[Хакер]

Поэтому я и думал в сторону использования коллекции как хранилища. Ведь у неё уже реализованы механизмы проверки наличия элемента по ключу.

Коллекция не нужна. Из пушки по воробьям. Чтобы избежать дублирования, достаточно пробежаться по существующему массиву и проверить наличие элемента с типом атрибута, совпадающего с тем, который пытаются добавить сейчас. С учётом того, что типов не много (как я предполагаю), это не вызовет проблемы в стиле «маляра Шлемеля». Если константы, обозначающие типы аргументов, имеют значение, соответствующие степеням двойки — можно использовать битовую карту. Да и если не имеют, то тоже можно, конвертируя код аргумента в маску.

В принципе мне надо, чтобы структура, созданная внутри класса, существовала до тех пор пока существует класс. Т.е последовательность такая:

Вот как раз реализация возможности замены значения атрибута и ставит меня в тупик. Не знаю как это правильно написать.

Подход с использованием Variant-ов для хранения значения в этом плане наиболее простой.
Класс существует всегда. Хватит путать класс и экземпляр класса.

[Jack Ferre]

С первого поста показалось понял, что ALX_2002 имеет ввиду, но последующие посты меня запутали.

Заинтересовала идея. Скорее всего мой исходник не пригодится в решении данной задачи, но я его уже написал
Класс CCKData.cls

Код: Выделить всё

Option Explicit

Private Const CK_DATATYPE_LONG = 7
Private Const CK_DATATYPE_STRING = 4
Private Const CK_DATATYPE_ARRAY = 3

Private Type CK_ATTRIBUTE
    type As Long
    lpValue As Long
    valueLen As Long
End Type

Dim m_struct As CK_ATTRIBUTE

Dim m_value_long As Long
Dim m_value_string As String
Dim m_value_bytearray() As Byte



Public Sub PutData(value)
    Select Case VarType(value)
        Case vbLong
            PutLong CLng(value)
        Case vbString
            PutString CStr(value)
        Case vbByte + vbArray
            PutByteArray CStr(value)
    End Select
End Sub

Private Sub PutLong(value As Long)
    m_value_long = value
    m_struct.type = CK_DATATYPE_LONG
    m_struct.lpValue = VarPtr(m_value_long)
    m_struct.valueLen = LenB(m_value_long)
End Sub

Private Sub PutString(value As String)
    m_value_string = value
    m_struct.type = CK_DATATYPE_STRING
    m_struct.lpValue = StrPtr(m_value_string)
    m_struct.valueLen = LenB(m_value_string)
End Sub

Private Sub PutByteArray(value() As Byte)
    m_value_bytearray = value
    m_struct.type = CK_DATATYPE_ARRAY
    m_struct.lpValue = VarPtr(m_value_bytearray(LBound(m_value_bytearray)))
    m_struct.valueLen = UBound(m_value_bytearray) - LBound(m_value_bytearray) + 1
End Sub

Public Property Get lpStruct() As Long
    lpStruct = VarPtr(m_struct)
End Property

Сначала сделал разные методы для разных типов, потом прочитал что нужно именно Variant и написал метод PutData.
С анатомией типа Variant не знаком и в связи с этим не знаю как извлечь из него данные. Сделал конвертацию.
Для каждого типа отдельная переменная. Как сделать иначе не знаю.

Пример заполнения коллекции и проверка извлечения данных. Форма Form1.frm (на форме кнопка Command1)

Код: Выделить всё

Option Explicit

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

Private Const CK_DATATYPE_LONG = 7
Private Const CK_DATATYPE_STRING = 4
Private Const CK_DATATYPE_ARRAY = 3

Private Type CK_ATTRIBUTE
    type As Long
    lpValue As Long
    valueLen As Long
End Type

Private data As New Collection



Private Sub Command1_Click()
    Dim i As Object
   
    Debug.Print
   
    For Each i In data
        Dim lpStruct As Long
        Dim struct As CK_ATTRIBUTE
       
        lpStruct = i.lpStruct
        CopyMemory struct, ByVal lpStruct, Len(struct)
        Debug.Print "STRUCT = [type: " & struct.type & " len: " & struct.valueLen & " value: " & struct.lpValue & "]"
       
        Select Case struct.type
            Case CK_DATATYPE_LONG
                Dim lValue As Long
                CopyMemory lValue, ByVal struct.lpValue, 4
                Debug.Print "  \ long -> " & lValue
               
            Case CK_DATATYPE_STRING
                Dim strValue As String
                strValue = Space(struct.valueLen / 2)
                CopyMemory ByVal StrPtr(strValue), ByVal struct.lpValue, struct.valueLen
                Debug.Print "  \ string -> " & strValue
               
            Case CK_DATATYPE_ARRAY
                Dim baValue() As Byte
                ReDim baValue(struct.valueLen)
                CopyMemory baValue(0), ByVal struct.lpValue, struct.valueLen
                Debug.Print "  \ byte array -> " & StrConv(baValue, vbUnicode)
        End Select
    Next
End Sub

Private Sub Form_Load()
    Dim objCKData As CCKData
   
    Set objCKData = New CCKData
    Dim lValue As Long
    lValue = 1234
    objCKData.PutData lValue
    data.Add objCKData, CStr(ObjPtr(objCKData))
   
    Set objCKData = New CCKData
    Dim strValue As String
    strValue = "hello"
    objCKData.PutData strValue
    data.Add objCKData, CStr(ObjPtr(objCKData))
   
    Set objCKData = New CCKData
    Dim baValue() As Byte
    baValue = StrConv("array", vbFromUnicode)
    objCKData.PutData baValue
    data.Add objCKData, CStr(ObjPtr(objCKData))
End Sub

Добавление в коллекцию понятно как. Удаление при наличии ссылки на экземпляр класса через указатель как ключ коллекции. При отсутствии ссылки выходит, что только очисткой коллекции.

UPD:

Единственное от чего хотел избавиться это дублирование атрибутов.

CCKData.cls

Код: Выделить всё

Public Property Get lpValue() As Long
    lpValue = m_struct.lpValue
End Property

Добавлять в коллекцию с ключом CStr(objCKData.lpValue) и отлавливать ошибку.

компромисс между удобством, скоростью, минимумом кода

Удобно, медленно, вроде не много.

[Хакер]

Jack Ferre, твой метод не годится, потому что не позволяет сделать массив структур CK_ATTRIBUTE.

[ALX_2002]

Jack Ferre, благодарю за участие. Сейчас поизучаю.

Хакер, решил перейти от слов к коду.

Собрал заготовку.

Есть проблема в получении указателя на данные внутри Variant. Не знаю как правильно это сделать.

Сделал форму с отладочным кодом

Код: Выделить всё

Dim oAttributeTemplate As New cAttributeTemplate
Private Sub Form_Load()
    With oAttributeTemplate
        'Добавляем атрибуты
        .SetAttribute 1, 1
        .SetAttribute 2, "ssss"
   
        Dim b() As Byte
        b = "test"
        .SetAttribute 3, b
       
        'Строим структуру
        MsgBox .BuildStruct
    End With
End Sub


и класс модуль cAttributeTemplate

Код: Выделить всё

Option Explicit

Option Base 1

'Объявление структуры
Private Type CK_ATTRIBUTE
    lType As Long
    lValue As Long
    lValueLen As Long '  '/* in bytes' */
End Type

'Массив хранящий массивы атрибутов
Private aAttributes() As Variant

'Объявление массива структур
Private aStructs() As CK_ATTRIBUTE

'Счётчик элементов
Private lCount As Long

'Метод создания / замены атрибута
Public Sub SetAttribute(ByVal AttributeType As Long, AttributeValue As Variant)
    Dim item As Variant
    'Проверяем существование элемента в массиве
    If lCount > 0 Then
        For Each item In aAttributes
            If item(1) = AttributeType Then
                'Замена значения
                item(2) = AttributeValue
                Exit Sub
            End If
        Next
    End If
    'Если в результате перебора элемент не был найден, то расширяем массив и добавляем элемент
    lCount = lCount + 1
    ReDim Preserve aAttributes(lCount) As Variant
    'В элемент массива кладём массив из двух элементов (ключ и значение)
    aAttributes(lCount) = Array(AttributeType, AttributeValue)
End Sub

'Функция построения структуры и заполнение ссылками на данные
Function BuildStruct() As Long
    Dim i As Long
   
    'Пересоздаём массив на нужное кол-во элементов
    ReDim aStructs(lCount) As CK_ATTRIBUTE
   
    For i = 1 To lCount
        With aStructs(i)
            'Выставляем тип атрибута
            .lType = aAttributes(i)(1)
            'Получаем ссылку на атрибут. Вроде бы у Variant заголовок 4 байта. Так что смещаемся до его конца.
            ' ???
            '.lValue = VarPtr(aAttributes(i)(2)) + 4
           
            'Получаем длину значения атрибута
            .lValueLen = LenB(aAttributes(i)(2))
        End With
    Next
   
    'Возвращаем указатель
    BuildStruct = VarPtr(aStructs(1))
End Function


Не знаю как правильно поступить в этой строке.

'.lValue = VarPtr(aAttributes(i)(2)) + 4

Надо в зависимости от типа данных выбирать StrPtr / VarPtr для получения указателя ? Нужно ли смещение ? И вообще правильно ли так делать ?

[Хакер]

Есть проблема в получении указателя на данные внутри Variant. Не знаю как правильно это сделать.

Вариант — такая же структура. Там есть поле (первое поле по смещению 0 от начала структуры), хранящее тип содержимого, и есть поле (по смещению , хранящее содержимое или указатель на содержимое.
Изучи: http://msdn.microsoft.com/en-us/library/ms221627

Код твой почитал — ужас. Зачем массив вариантов, каждый элемент которых хранит массив вариатов? У тебя же уже есть структура.

[Хакер]

Бесполезно вообще браться за написание какого-либо кода, пока ты не приведёшь выдержку из документации, которая бы рассказывала о том, в каком виде/формате/кодировки библиотека ожидает получать строки.

[ALX_2002]

Хакер, благодарствую за ссылочку. Сейчас изучу. )

Код твой почитал — ужас. Зачем массив вариантов, каждый элемент которых хранит массив вариатов? У тебя же уже есть структура.

Оу. Кажется понял. Сейчас попробую переделать.

Бесполезно вообще браться за написание какого-либо кода, пока ты не приведёшь выдержку из документации, которая бы рассказывала о том, в каком виде/формате/кодировки библиотека ожидает получать строки.

Ясно. ) Сейчас гляну.

[Jack Ferre]

Что не должно совпадать в массиве структур? lType? Т.е. не больше одного лонга, строки, массива?

[Хакер]

Что не должно совпадать в массиве структур? lType? Т.е. не больше одного лонга, строки, массива?

Кому обращена эта фраза?

[ALX_2002]

Хакер, в документации написано - RFC2279 string.. Поискал что это такое. Пишут, что это UTF-8.

[Хакер]

Ну вот, значит просто так передавать нельзя.

[ALX_2002]

Ну вот, значит просто так передавать нельзя.

Поясни пожалуйста на что это влияет ? По идее же - передал указатель на начало строки и длину в байтах. А что там внутри библиотеке же наплевать ? Что я не учитываю ?

Переделал код. Надеюсь правильно понял твою рекомендацию.

Код: Выделить всё

Option Explicit

Option Base 1

'Объявление структуры
Private Type CK_ATTRIBUTE
    lType As Long
    lValue As Long
    lValueLen As Long '  '/* in bytes' */
End Type

'Массив хранящий массивы атрибутов
Private aAttributes() As Variant

'Объявление массива структур
Private aStructs() As CK_ATTRIBUTE

'Счётчик элементов
Private lCount As Long

'Метод создания / замены атрибута
Public Sub SetAttribute(ByVal AttributeType As Long, AttributeValue As Variant)
    Dim i As Long
    'Проверяем нет ли в массиве такого атрибута
    For i = 1 To lCount
        With aStructs(i)
            If .lType = AttributeType Then
                'Если есть, то обновляем в нём данные
                '??? Вот тут и тупик
                .lValue = VarPtr(aAttributes(i))
                '??? И по ходу длину тоже не так считать надо ???
                .lValueLen = LenB(aAttributes(i))
                Exit For
            End If
        End With
    Next
    lCount = lCount + 1
    'Добавляем элемент в оба массива
    ReDim Preserve aAttributes(lCount) As Variant
    ReDim Preserve aStructs(lCount) As CK_ATTRIBUTE
    'Передаём в массив значений новое значение
    aAttributes(lCount) = AttributeValue
   
    With aStructs(lCount)
        .lType = AttributeType
        .lValue = VarPtr(aAttributes(lCount))
        .lValueLen = LenB(aAttributes(lCount))
    End With
End Sub

'Функция построения структуры и заполнение ссылками на данные
Function GetStructPointer() As Long
    GetStructPointer = VarPtr(aStructs(1))
End Function


[Хакер]

А что там внутри библиотеке же наплевать ? Что я не учитываю ?

Почему наплевать? Она же что-то делает со строкой, которую получает. Иначе зачем ей вообще получать строку?

[Jack Ferre]

CCKData.cls

Код: Выделить всё

Option Explicit

Private Const CK_DATATYPE_LONG = 7
Private Const CK_DATATYPE_STRING = 4
Private Const CK_DATATYPE_ARRAY = 3

Private Type CK_ATTRIBUTE
    type As Long
    lpValue As Long
    valueLen As Long
End Type

Dim m_structs() As CK_ATTRIBUTE

Dim m_long As Long
Dim m_string As String
Dim m_bytearray As String

Dim m_count As Long



Public Sub PutData(value)
    Select Case VarType(value)
        Case vbLong
            PutLong CLng(value)
        Case vbString
            PutString CStr(value)
        Case vbByte + vbArray
            PutByteArray CStr(value)
    End Select
End Sub

Private Sub AddNewItem(already As Boolean, index As Long)
    If Not already Then
        ReDim Preserve m_structs(m_count)
        index = m_count
        m_count = m_count + 1
        already = True
    End If
End Sub

Private Sub PutLong(value As Long)
    Static already As Boolean
    Static index As Long
   
    AddNewItem already, index
   
    m_long = value
    m_structs(index).type = CK_DATATYPE_LONG
    m_structs(index).lpValue = VarPtr(m_long)
    m_structs(index).valueLen = 4
End Sub

Private Sub PutString(value As String)
    Static already As Boolean
    Static index As Long
   
    AddNewItem already, index
   
    m_string = value
    m_structs(index).type = CK_DATATYPE_STRING
    m_structs(index).lpValue = StrPtr(m_string)
    m_structs(index).valueLen = LenB(m_string)
End Sub

Private Sub PutByteArray(value() As Byte)
    Static already As Boolean
    Static index As Long
   
    AddNewItem already, index
   
    m_bytearray = value
    m_structs(index).type = CK_DATATYPE_ARRAY
    m_structs(index).lpValue = StrPtr(m_bytearray)
    m_structs(index).valueLen = LenB(m_bytearray)
End Sub

Public Property Get lpStruct() As Long
    lpStruct = VarPtr(m_structs(0))
End Property

Public Property Get Count() As Long
    Count = m_count
End Property

Form1.frm

Код: Выделить всё

Option Explicit

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

Private Const CK_DATATYPE_LONG = 7
Private Const CK_DATATYPE_STRING = 4
Private Const CK_DATATYPE_ARRAY = 3

Private Type CK_ATTRIBUTE
    type As Long
    lpValue As Long
    valueLen As Long
End Type

Private data As New Collection



Private Sub Command1_Click()
    Dim i As Object
   
    Debug.Print
   
    For Each i In data
        Dim lpStruct As Long
        Dim struct As CK_ATTRIBUTE
        Dim j As Long
       
        lpStruct = i.lpStruct
       
        For j = 0 To i.Count - 1
            CopyMemory struct, ByVal (lpStruct + j * Len(struct)), Len(struct)
            Debug.Print "STRUCT = [type: " & struct.type & " len: " & struct.valueLen & " value: " & struct.lpValue & "]"
           
            Select Case struct.type
                Case CK_DATATYPE_LONG
                    Dim lValue As Long
                    CopyMemory lValue, ByVal struct.lpValue, 4
                    Debug.Print "  \ long -> " & lValue
                   
                Case CK_DATATYPE_STRING
                    Dim strValue As String
                    strValue = Space(struct.valueLen / 2)
                    CopyMemory ByVal StrPtr(strValue), ByVal struct.lpValue, struct.valueLen
                    Debug.Print "  \ string -> " & strValue
                   
                Case CK_DATATYPE_ARRAY
                    Dim baValue() As Byte
                    ReDim baValue(struct.valueLen)
                    CopyMemory baValue(0), ByVal struct.lpValue, struct.valueLen
                    Debug.Print "  \ byte array -> " & StrConv(baValue, vbUnicode)
            End Select
        Next j
    Next i
End Sub

Private Sub Form_Load()
    Dim objCKData As CCKData
   
    Set objCKData = New CCKData
    objCKData.PutData 90009000
    objCKData.PutData "world"
    objCKData.PutData 5678&
    data.Add objCKData, CStr(ObjPtr(objCKData))
   
    Set objCKData = New CCKData
    objCKData.PutData "hello"
    objCKData.PutData 1234&
    data.Add objCKData, CStr(ObjPtr(objCKData))
   
    Set objCKData = New CCKData
    Dim baValue() As Byte
    baValue = StrConv("array", vbFromUnicode)
    objCKData.PutData baValue
    baValue = StrConv("data", vbFromUnicode)
    objCKData.PutData baValue
    data.Add objCKData, CStr(ObjPtr(objCKData))
End Sub

[The trick]

Строки в VB6 - BSTR (USC-2, хотя можно хранить все что угодно), для преобразования в UTF-8 нужно использовать WideCharToMultibyte.
В идеале нужно делать несколько массивов для каждого типа данных, т.к. при Redim могут смениться адреса, либо делать еще массив индексов. ПРи вызове формировать структуры, ссылающиеся на эти массивы. Variant'ом я бы не стал пользоваться, т.к. для засовывания UDT в Variant нужно объявлять ее в TLB (напрямую, либо через отдельный ActiveX проект), хотя возможно UDT не нужны тебе.

Вот небольшой пример накидал:

Код: Выделить всё

Option Explicit

Private Type CK_ATTRIBUTE
    lType       As Long
    lValue      As Long
    lValueLen   As Long
End Type

Private Declare Sub memcpy Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetMem4 Lib "msvbvm60" (Src As Any, Dst As Any) As Long

Dim mDat()  As Long         ' Данные
Dim mIdx()  As Long         ' Индексы
Dim mOut()  As CK_ATTRIBUTE ' Данные
Dim mSize   As Long         ' Размер данных в байтах с учетом выравнивания
Dim mCount  As Long         ' Количество элементов в массиве

Public Function Add(value As Variant) As Boolean
    Dim size    As Long
    Dim ptr     As Long
    Dim count   As Long
    Dim index   As Long
    Dim isStr   As Boolean
   
    ptr = VarPtr(value) + 8
   
    Select Case VarType(value) And (Not VbVarType.vbArray)
    Case VbVarType.vbLong:      size = 4
    Case VbVarType.vbInteger:   size = 2
    Case VbVarType.vbSingle:    size = 4
    Case VbVarType.vbDouble:    size = 8
    Case VbVarType.vbBoolean:   size = 2
    Case VbVarType.vbByte:      size = 1
    Case VbVarType.vbCurrency:  size = 8
    Case VbVarType.vbDate:      size = 8
    Case VbVarType.vbString
        ' Строку сам конвертанешь
        size = LenB(value)
        GetMem4 ByVal VarPtr(value) + 8, ptr
        isStr = True
    Case Else: Exit Function
    End Select
   
    If CBool(VarType(value) And vbArray) Then
        If isStr Then Exit Function
        ' Получаем SafeArray
        GetMem4 ByVal VarPtr(value) + 8, ptr
        If ptr = 0 Then Exit Function
        ' Получаем указатель на данные
        GetMem4 ByVal ptr + &HC, ptr
        size = size * (UBound(value) + 1)
    End If
   
    ' Тут можно сделать порционно для оптимизации
    index = mSize \ 4
    count = -Int(-(mSize + size) / 4)
    mSize = count * 4
    ReDim Preserve mDat(count - 1)
    ReDim Preserve mIdx(mCount)
    ReDim Preserve mOut(mCount)
   
    'Заполняем неизменяющиеся данные
    mOut(mCount).lType = VarType(value)
    mOut(mCount).lValueLen = size
   
    ' Заполняем индекс
    mIdx(mCount) = index
    mCount = mCount + 1
   
    ' Копируем данные
    memcpy mDat(index), ByVal ptr, size
   
End Function

Public Property Get Address() As Long
    Dim index   As Long
   
    If mCount = 0 Then Exit Property
   
    ' Формируем указатели
    For index = 0 To mCount - 1
        mOut(index).lValue = VarPtr(mDat(mIdx(index)))
    Next
   
    Address = VarPtr(mOut(0))
   
End Property


[ALX_2002]

Ого ! Сколько ответов ! Благодарю за активную помощь господа ! Сейчас изучу примеры.

Почему наплевать? Она же что-то делает со строкой, которую получает. Иначе зачем ей вообще получать строку?

Хакер, так я ж с этого и начал

Я скармливал ей двухбайтовый юникод. Так как функции библиотеки никак не анализируют значение внутри, то и кодировка получается им не столь важна.

Самой библиотеки содержимое строки вообще по боку. Та функция, которую я привёл как пример, ищет ключи на устройстве (USB-токене) по заданному шаблону. К примеру по Label. Т.к Label задаётся мной (ключи генерирую я сам и лэйбл задаю тоже я), то только мне важно в какой кодировке я пишу и читаю.

Строки в VB6 - BSTR (USC-2, хотя можно хранить все что угодно), для преобразования в UTF-8 нужно использовать WideCharToMultibyte.
В идеале нужно делать несколько массивов для каждого типа данных, т.к. при Redim могут смениться адреса, либо делать еще массив индексов. ПРи вызове формировать структуры, ссылающиеся на эти массивы. Variant'ом я бы не стал пользоваться, т.к. для засовывания UDT в Variant нужно объявлять ее в TLB (напрямую, либо через отдельный ActiveX проект), хотя возможно UDT не нужны тебе.

Угу. Частично понял. Действительно совсем забыл, что ReDim адресацию меняет.

[Хакер]

Хакер, так я ж с этого и начал

Я скармливал ей двухбайтовый юникод. Так как функции библиотеки никак не анализируют значение внутри, то и кодировка получается им не столь важна.

Это бред и ничего не значит. Если библиотеке вообще никоим образом не нужна строка, то нет смысла и передавать ей строку. Если всё же есть смысл передавать ей строку, значит со строкой она что-то всё же делает. А если со строкой она всё же что-то делает, значит строку ей нужно передавать в правильном виде.

[ALX_2002]

В общем решил задачку. Вашими молитвами и поддержкой.

Поковыряв структуру Variant и поизучав код Кривоуса Анатолия, понял что не потянет моя хилая соображалка пересобрать это всё под себя. Потому решил создать класс модуль отдельного Атрибута и в нём создать 3 типа переменных, которые мне нужны Long / String / Byte(). В методе Value решаю как получать указатель. А дальше всё стало проще не куда. Собрал построитель шаблона и в поля подсунул указатели от созданных экземпляров классов атрибутов. И всё заработало. Да, понимаю, решение корявое, но код для меня получился прозрачным и простым.

Код: Выделить всё

Private lValue As Long
Private bValue() As Byte
Private sValue As String
Private lPointer As Long
Private lLength As Long

Public Property Let Value(data As Variant)
    lValue = 0
    Dim bTmp() As Byte
    bValue = bTmp
    sValue = ""
   
    Select Case VarType(data)
    Case vbLong, vbInteger
        lValue = data
        lPointer = VarPtr(lValue)
    Case vbString, vbDate, vbCurrency
        sValue = data
        lPointer = StrPtr(sValue)
    Case vbArray Or vbByte
        bValue = data
        lPointer = VarPtr(bValue(0))
    Case Else
        Err.Raise vbObjectError + 1, "cAttribute", "Invalid data type"
    End Select
    lLength = LenB(data)
End Property

Public Property Get Pointer() As Long
    Pointer = lPointer
End Property

Public Property Get Length() As Long
    Length = lLength
End Property


Всем спасибо за помощь и содействие !

[Хакер]

Нет, не спасибо.
Пока со строками не сделаешь правильно, проблему нельзя считать решённой.

[ALX_2002]

Нет, не спасибо.
Пока со строками не сделаешь правильно, проблему нельзя считать решённой.

Да а чего её решать то ? ) Я ж говорю - библиотека само значение в строке никак не анализирует.

[Jack Ferre]

Кривоус Анатолий, пример по скорости конечно быстрее моего
(bug) При попытки добавления массива байт после любого другого типа данных программа падает.
(add) Проверка наличия данных такого же типа и замена их, если таковые имеются, путем смещения правой части массива на разницу между новым и старым размерами данных.

ALX_2002, как-то у вас разрозненно получается - данные отдельно, структуры отдельно. Вам же предлагают простой интерфейс:
PutData / Add - добавление данных.
lpStruct / Address - указатель на массив структур.
Count - количество элементов в массиве структур.

Немного о своём коде:
PutData - определение типа данных.
PutLong / PutString / PutByteArray - сохранение данных в переменных класса и заполнение элемента массива структур.
AddNewItem - проверка наличия данных такого же типа и, в зависимости от результата, перезапись или добавление нового элемента массива структур (функциями PutLong / PutString / PutByteArray).

Код в Form1.frm не относится к решению данной задачи.
Form_Load - пример добавления данных.
Command1_Click - демонстрация возможности чтения данных (пример Кривоуса Анатолия так же можно проверить этой функцией (при замене lpStruct = i.lpStruct на lpStruct = i.Address и констант в select case (например CK_DATATYPE_LONG на vbLong)))

Пока со строками не сделаешь правильно, проблему нельзя считать решённой.

Для решения этой проблемы замените строку PutString CStr(value) на PutString ВашаФункцияКодированияВUTF8(CStr(value))

[ALX_2002]

Jack Ferre, собрал пример по Вашему коду. Не смог понять куда складываются данные для каждого элемента из массива структур CK_ATTRIBUTE. Т.е - смотрю на код в CCKData

Код: Выделить всё

Dim m_structs() As CK_ATTRIBUTE

Dim m_long As Long
Dim m_string As String
Dim m_bytearray As String


Вижу что 3 типа данных объявлено в трёх отдельных переменных. Как сослаться на них для одной структуры это я понял, а когда структур несколько не понимаю как процесс работает.

Хакер, ты как всегда оказался прав. Пришлось конвертить данные под однобайтовые через StrConv, а то функция поиска не находит ключи с Label-ами созданными другой программой.

[Хакер]

Для решения этой проблемы замените строку PutString CStr(value) на PutString ВашаФункцияКодированияВUTF8(CStr(value))

За такие вещи надо отрывать руки, в образовавшиеся торцы вкручивать кол.

Да а чего её решать то ? ) Я ж говорю - библиотека само значение в строке никак не анализирует.

Хватит устраивать тормоза на ровном месте. Анализирует — это хитровывернутый термин. Никто точно не знает, что он обозначает. Да и не нужно это знать.

Есть две ситуации.

• Библиотека никак не использует строки. В этом случае можно не париться на счёт кодировки. Но вообще-то в этом случае можно и не передавать ничего (ведь библиотека не использует).
• Библиотека как-то использует строки. В этом случае ты обязан предоставить их в правильном виде.

Хакер, ты как всегда оказался прав.

Потому что это очевидно. Библиотека не «анализирует», а банально использует строки. Абсолютно не важно как. А раз использует — будьте добры предоставить их в нужном формате. А если вдруг не использует, то и передавать смысла нет.

Пришлось конвертить данные под однобайтовые через StrConv, а то функция поиска не находит ключи с Label-ами созданными другой программой.

Это отвратительно. Потому что StrConv не конвертирует UCS-2 в UTF-8. Конвертирование UCS-2 в UTF-8 делается с помощью WideCharToMultiByte, как было указано выше.

Вот так ты пишешь программы, которые создают вечные нелепые проблемы с обработкой строк. И я не смогу в твоём банке получить деньги, когда перевод мне сделает Freddy Krüger, потому что благодаря твоему чудному коду он превратится в какое-нибудь Freddy Krжger.

Не смей писать ни строчки кода, пока не прочитаешь абсолютный минимум, который каждый разработчик должен знать о юникоде и кодировках.