Ассоциативные массивы в VB6.

[RXL]

Ощущаю потребность в полноценных ассоциативных массивах, чтобы не только был доступ по текстовому ключу, но и иметь возможность перечислять эти ключи через for each. Collection тут не подходит. Вполне подошло бы решение подобное ADODB.Record и ADODB.Field, но без привязки к БД.

Вопрос, есть ли что-нибудь готовое более-менее стандартное? Поиск не помогает. И обязательно нужно для VB6, а не VB.NET. Писать свой класс коллекции не хочется, но если не будет выхода, то придется.

[RXL]

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

Привожу здесь - может, кому интересно будет.
Если что - все претензии к Майкрософт - тут ни одной моей строчки.

Класс CAssocItem:

Код: (Visual Basic)

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
 Persistable = 0  'NotPersistable
 DataBindingBehavior = 0  'vbNone
 DataSourceBehavior  = 0  'vbNone
 MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CAssocItem"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"No"
Public Key As String

'local variable(s) to hold property value(s)
Private mvarValue As Variant 'local copy
Public Property Let Value(ByVal vData As Variant)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.Value = 5
   mvarValue = vData
End Property

Public Property Set Value(ByVal vData As Variant)
'used when assigning an Object to the property, on the left side of a Set statement.
'Syntax: Set x.Value = Form1
   Set mvarValue = vData
End Property

Public Property Get Value() As Variant
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Value
   If IsObject(mvarValue) Then
        Set Value = mvarValue
    Else
        Value = mvarValue
    End If
End Property

Класс CAssocArray:

Код: (Visual Basic)

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
 Persistable = 0  'NotPersistable
 DataBindingBehavior = 0  'vbNone
 DataSourceBehavior  = 0  'vbNone
 MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CAssocArray"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Collection" ,"CItem"
Attribute VB_Ext_KEY = "Member0" ,"CItem"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'local variable to hold collection
Private mCol As Collection

Public Function Add(Key As String, Value As Variant, Optional sKey As String) As CAssocItem
    'create a new object
   Dim objNewMember As CAssocItem
    Set objNewMember = New CAssocItem

    'set the properties passed into the method
   objNewMember.Key = Key
    If IsObject(Value) Then
        Set objNewMember.Value = Value
    Else
        objNewMember.Value = Value
    End If
    If Len(sKey) = 0 Then
        mCol.Add objNewMember
    Else
        mCol.Add objNewMember, sKey
    End If

    'return the object created
   Set Add = objNewMember
    Set objNewMember = Nothing
End Function

Public Property Get item(vntIndexKey As Variant) As CAssocItem
Attribute item.VB_UserMemId = 0
    'used when referencing an element in the collection
   'vntIndexKey contains either the Index or Key to the collection,
   'this is why it is declared as a Variant
   'Syntax: Set foo = x.Item(xyz) or Set foo = x.Item(5)
 Set item = mCol(vntIndexKey)
End Property

Public Property Get Count() As Long
    'used when retrieving the number of elements in the
   'collection. Syntax: Debug.Print x.Count
   Count = mCol.Count
End Property

Public Sub Remove(vntIndexKey As Variant)
    'used when removing an element from the collection
   'vntIndexKey contains either the Index or Key, which is why
   'it is declared as a Variant
   'Syntax: x.Remove(xyz)
   mCol.Remove vntIndexKey
End Sub

Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
    'this property allows you to enumerate
   'this collection with the For...Each syntax
   Set NewEnum = mCol.[_NewEnum]
End Property

Private Sub Class_Initialize()
    'creates the collection when this class is created
   Set mCol = New Collection
End Sub

Private Sub Class_Terminate()
    'destroys collection when this class is terminated
   Set mCol = Nothing
End Sub

Тестик:

Код:

Private Sub Command1_Click()
    Dim arr As New CAssocArray
    Dim item As CAssocItem
    
    Call arr.Add("key 1", 10)
    Call arr.Add("key 2", "text")
    
    For Each item In arr
        Call MsgBox(item.Key + "=" + CStr(item.Value))
    Next
End Sub

Корявенько, конечно, но что делать, коли лучшего нет...

[Алексей++]

ассоциативный массив - это как ? Это вроде std::map ?

[RXL]

Да.


Вот за что ненавижу VB, так за "информативность" ошибок и понятность действий.

Код:

Public Property Get item(vntIndexKey As Variant) As CAssocItem
    'used when referencing an element in the collection
    'vntIndexKey contains either the Index or Key to the collection,
    'this is why it is declared as a Variant
    'Syntax: Set foo = x.Item(xyz) or Set foo = x.Item(5)
  Set item = mCol(vntIndexKey)
End Property

На Set item = mCol(vntIndexKey) говорит "Invalid procedure call or argument".
mCol имеет тип Collection. Ключ, содержащийся в vntIndexKey, присутствует. Код сгенерен визардом.
Вызывает метод следующий мой код:

Код:

Private Sub Command4_Click()
    Dim arr As New CAssocArray
    Dim item As CAssocItem
    
    Call arr.Add("f1", 10)
    Call arr.Add("f2", "zhopa")
    
    Call MsgBox(arr("f2").Value)
End Sub

На arr("f2") и происходит Ж...


Подмена индекса в процессе отладки показала, что сбой происходит из-за текстового индекса. Фигня какая-то...

[RXL]

В общем, разобрался и починил. Совершенно не вижу смысла в действиях визарда...
Визард не понятно зачем жестко создал мембер CAssocItem.Key (даже не позволил переименовать). В методе CAssocArray.Add было 3 параметра: Key, Value и sKey (опционально). Странное дело: если был sKey, то он использовался как индекс, если не было, то использовалась автоматическая числовая нумерация Collection, но в CAssocItem.Key всегда сохранялся параметр Key. Бред какой-то...

Я переписал метод на CAssocArray.Add(Key, Value), где Key используется как ключ Collection и за одно копируется в CAssocItem.Key.
Для полноты картины не хватает только защиты CAssocItem.Key, т.к. это public member.

CAssocItem.cls:

Код:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CAssocItem"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"

Public Key As String

Private mvarValue As Variant

Public Property Let Value(ByVal vData As Variant)
    mvarValue = vData
End Property

Public Property Set Value(ByVal vData As Variant)
    Set mvarValue = vData
End Property

Public Property Get Value() As Variant
    If IsObject(mvarValue) Then
        Set Value = mvarValue
    Else
        Value = mvarValue
    End If
End Property

CAssocArray.cls:

Код:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CAssocArray"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"No"
Attribute VB_Ext_KEY = "Collection" ,"CAssocItem"
Attribute VB_Ext_KEY = "Member0" ,"CAssocItem"

Private mCol As Collection

Public Function Add(Key As String, Value As Variant) As CAssocItem
    Set Add = New CAssocItem
    Add.Key = Key
    
    If IsObject(Value) Then
        Set Add.Value = Value
    Else
        Add.Value = Value
    End If
    
    Call mCol.Add(Add, Key)
End Function

Public Property Get Item(vntIndexKey As String) As CAssocItem
Attribute Item.VB_UserMemId = 0
    Set Item = mCol(vntIndexKey)
End Property

Public Property Get Count() As Long
    Count = mCol.Count
End Property
Public Sub Remove(vntIndexKey As String)
    Call mCol.Remove(vntIndexKey)
End Sub

Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
    Set NewEnum = mCol.[_NewEnum]
End Property

Private Sub Class_Initialize()
    Set mCol = New Collection
End Sub

Private Sub Class_Terminate()
    Set mCol = Nothing
End Sub

[HandKot]

подойдет?

Код:

Public rs As New ADODB.Recordset

Public Sub test()
    Dim fld As ADODB.Field
    
    'создаем структуру
    rs.Fields.Append "field1", adChar, 10
    rs.Fields.Append "field2", adInteger
    rs.Fields.Append "field3", adInteger
    
    'открываем
    rs.Open
    
    'заполняем структуру
    InsertData "row1", 1, 1
    InsertData "row2", 2, 2
    InsertData "row3", 3, 3
    
    
    'просто бежимся и выводим значения
    rs.MoveFirst
    While Not rs.EOF
        For Each fld In rs.Fields
            Debug.Print fld.Value
        Next fld
        Debug.Print "======================"
        rs.MoveNext
    Wend
    
    'поиск по ключу
    rs.Find "field1 = 'row2'", , adSearchForward, 1
    Debug.Print rs.Fields("field1").Value
    
    'уничтожаем объект
    Set rs = Nothing
End Sub

Public Sub InsertData(f1 As String, f2 As Integer, f3 As Integer)
    'Добавляем новую запись
    rs.AddNew
    
    'заполняем значение полей
    rs.Fields("field1") = f1
    rs.Fields("field2") = f2
    rs.Fields("field3") = f3
    
    'коммитим операцию
    rs.Update
End Sub

Пока спецы спали

не, просто по выходным в инет вообще ни ногой 

[RXL]

HandKot, спасибо.

Recordset может жить отдельно от БД? 

А что скажешь о моем решении?

[HandKot]

Recordset может жить отдельно от БД? 

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

А что скажешь о моем решении?

классы достаточно красивое решение, НО с ними в шестом Васике не работал и поэтому не могу оценить код

ЗЫЖ предложил код из-за того, что ты много ругался на VB6, и мой код немного проще чем с классами
хотя, если мой код представить в виде класса, наверное вообще чума будет  и наверно то, что нужно

[RXL]

Меня VB6 вообще пугает нелогичностями и тупизной, а еще больше тем, что в редакторе не работает прокрутка колесом. Не помню точно, кажется в VS2008 она также не работает.

Назрел еще вопрос...
У меня есть модуль кастомизации приложения. Написали его в конторе поставщика ПО еще в 2000-м году. Тогда их ПО было написано на VB6. Текущая версия ПО написана на VB.NET (.NET 1.1), но custom dll по прежнему на VB6 и работает - ее то я и переписываю.
Вопрос такой: имеет ли смысл напрячься и переписать его на VB.NET? Попытки конвертации проекта пробовал делать, но возникают всякие трудности с совместимостью и внешними компонентами. Стоит заморачиваться - удобнее ли работать с API .NET 1.1?

[HandKot]

отвечу так
" Сидит папа-программист в "глубокой" отладке, мозг распух, программа не ладится, почему, не понятно, вроде всё должно работать, сроки поджимают, в общем, завал. Подходит сын: "Пап, а почему Солнце каждый Вечер заходит, а утром выходит?".
Папа поднимает взгляд, вникает в сказанное.
- Точно? И заходит, и выходит?
- Да!
-Ты хорошо проверил? Уверен?
- Да, каждый день так.
Хватает сына за плечи и трясет.
- Сынок, только ничего не трогай! Ничего не трогай и не лезь туда!"

ЗЫЖ моя специализация БД, на васике пишу иногда интерфейсы и многих тонкостей не знаю
чтоб получить достойный ответ? спроси на bbs.vbstreets.ru

[RXL]

Понятно.
Одно отличие только в том, что иногда (примерно раз в год) я вношу в эту dll новые фичи и нахожу это занятие довольно геморройным. Если бы знать, что API .NET 1.1 лучше и удобнее, то можно было бы напрячься один раз и переписать.
А так я тоже не по VB - по различным базам, BCB6, Crystal Reports и разным админско-программистским радостям. Просто кроме меня некому...

[HandKot]

кстати насчет переписки проекта на ДОТНЕТ.
все зависит от того как часто надо доделывать ДЛЛ и сколько планируется её использовать
учитывапя слухи о том, что мелкософт  в ближайшее время планирует отказатся от поддержки Басика, то имеет смысл перевести проект на новую платформу.