Данные обновляются с задержкой. Глюк или фича?

[ger_kar]

База данных mdb, провайдер OLEDB MS Jet4.0, доступ к данным через ADODB.
В приложении реализована событийная модель для обновления данных. Т.е. например пользователь в справочнике меняет наименование, при обновлении данных в базе через Recordset.Update Возникает событие. И где то там может быть открыта форма или формы, в которых используются списки трансляции идентификаторов в наименования, которые могут поймать событие и обновиться. Так вот, если добавляется новая запись, то все обновляется без проблем. А если запись подредактировать, то получается ситуация, что событие на обновление возникает раньше, чем данные обновились в базе и запрос по событию считывает старые данные. Почему такое странное поведение? При добавлении данных база успевает обновиться, а при обычном изменении нет. Как такое можно побороть? Как поймать момент именно обновления самой базы, а не рекордсета?

[HandKot]

ger_kar , мой вопрос не совсем по теме, а для общего развития.Расскажите поподробнее об этой событийной модели. Как реализована?

[ger_kar]

Все очень просто. Так как события из простого модуля генерировать нельзя, то нужен глобальный объект для этих целей.
У меня таким объектом служит объект, единственный экземпляр которого порождается из класса CEventsDB (код класса ниже)

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

'--------------------------------------------------------------------------------------------------------
' Module    : CEventsDB
' Date      : 14.11.2013
' Purpose   : Класс для генерации глобальных событий обновления данных
'--------------------------------------------------------------------------------------------------------

Option Explicit

'{CEventsDB}
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'|Класс для генерации глобальных событий обновления данных из подсистемы уведомлений
'|Существует в единственном экземпляре (глобальная DAN ссылка), все объекты которым необходимы события
'|обновления должны иметь ссылку на этот объект с подпиской на события (WithEvents).
'|В подсистеме участвуют следующие классы:
'|  CDataUpdate     - Класс данных вносимых в коллекцию событий обновления полей рекордсетов
'|  CEventHandlerRs - Класс обработчик событий рекордсета
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

'[ПЕРЕМЕННЫЕ МОДУЛЯ]
    '
    Private m_Col           As Collection
   
'[ДЕКЛАРАЦИЯ СОБЫТИЙ]
    '
    Event DataChanged(ByVal adReason As ADODB.EventReasonEnum, _
                      ByVal cRecords As Long, _
                      ByVal pRS As ADODB.Recordset, _
                      ByVal sTableName As String _
                      )
    '

'////////////////////////////////////////////////////////////////////////////////////////////////////////
'                                    + С В О Й С Т В А   К Л А С С А +
'////////////////////////////////////////////////////////////////////////////////////////////////////////



'////////////////////////////////////////////////////////////////////////////////////////////////////////
'                                      + М Е Т О Д Ы   К Л А С С А +
'////////////////////////////////////////////////////////////////////////////////////////////////////////

'Method [UpdateField]  -
'**********************************************************************************************
    Public Sub UpdateField(ByVal cFields As Long, _
                           ByVal Fields As Variant, _
                           ByVal pRS As ADODB.Recordset _
                           )
        Dim oDU         As CDataUpdate
       
        Set oDU = New CDataUpdate
            Set oDU.Field = Fields(0)
            Set oDU.RS = pRS
            Let oDU.Key = GetGUIDString
            m_Col.Add oDU, oDU.Key
        Set oDU = Nothing
       
    End Sub
   
'Method [UpdateRecord]  -
'**********************************************************************************************
    Public Sub UpdateRecord(ByVal adReason As ADODB.EventReasonEnum, _
                            ByVal cRecords As Long, _
                            ByVal pRS As ADODB.Recordset _
                            )
        Dim sTableName  As String
        Dim sBuff       As String
        Dim oDU         As CDataUpdate
       
       
        If adReason = adRsnUpdate Then
            For Each oDU In m_Col
                If oDU.RS Is pRS Then
                    sBuff = Nzs(oDU.Field.Properties("BASETABLENAME").Value)
                    If Len(sTableName) = 0 Then
                        sTableName = sBuff
                    Else
                        If sTableName <> sBuff Then
                            '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
                            RaiseEvent DataChanged(adReason, cRecords, pRS, sTableName)
                            sTableName = sBuff
                        End If
                    End If
                    m_Col.Remove oDU.Key
                End If
            Next
            If Len(sTableName) <> 0 Then
                '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
                RaiseEvent DataChanged(adReason, cRecords, pRS, sTableName)
                sTableName = vbNullString
            End If
        ElseIf adReason = adRsnDelete Then
            sTableName = pRS!ID.Properties("BASETABLENAME").Value
            '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
            RaiseEvent DataChanged(adReason, cRecords, pRS, sTableName)
        End If
       
    End Sub

'Method [UpdateTable]  -
'**********************************************************************************************
    Public Sub UpdateTable(ByVal adReason As ADODB.EventReasonEnum, _
                           ByVal cRecords As Long, _
                           ByVal pRS As ADODB.Recordset, _
                           ByVal sTableName As String _
                           )
        DoEvents
        '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
        RaiseEvent DataChanged(adReason, cRecords, pRS, sTableName)
    End Sub


'////////////////////////////////////////////////////////////////////////////////////////////////////////
'                                 + О Б Р А Б О Т Ч К И   С О Б Ы Т И Й +
'////////////////////////////////////////////////////////////////////////////////////////////////////////

'[Class_Initialize]
'********************************************************************************************************
    Private Sub Class_Initialize()
        Set m_Col = New Collection
    End Sub

'[Class_Terminate]
'********************************************************************************************************
    Private Sub Class_Terminate()
        Set m_Col = Nothing
    End Sub


Этот глобальный объект содержит коллекцию событий, элементами которой являются экземпляры класса CDataUpdate

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

'--------------------------------------------------------------------------------------------------------
' Module    : CDataUpdate
' Date      : 14.11.2013
' Purpose   : Класс 'Обновленные данные' для коллекции событий
'--------------------------------------------------------------------------------------------------------

Option Explicit

'{CDataUpdate}
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'|Класс с данными для коллекции событий обновления полей рекордсетов.
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++


'////////////////////////////////////////////////////////////////////////////////////////////////////////
'                                    + С В О Й С Т В А   К Л А С С А +
'////////////////////////////////////////////////////////////////////////////////////////////////////////
   
'[ПУБЛИЧНЫЕ ПОЛЯ КЛАССА]
    Public RS       As ADODB.Recordset      'Ссылка на рекордсет, который обновился
    Public Field    As ADODB.Field          'Поле которое обновилось
    Public Key      As String               'Уникальный ключ на основе UUID

События порождаются в основном при манипуляциях с рекордсетами. Чтобы не плодить обработчики для каждого рекордсета я сделал отдельный класс обработчиков

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

'--------------------------------------------------------------------------------------------------------
' Module    : CEventHandlerRs
' Date      : 14.11.2013
' Purpose   : Класс 'Обработчик событий рекордсета'
'--------------------------------------------------------------------------------------------------------

Option Explicit

'{CEventHandlerRs}
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'|Класс обработчик событий рекордсета. Устанавливается ссылка на рекордсет с подпиской на события.
'|После связи с рекордсетом каждый экземпляр начинает обрабатывать все события обновления рекордсета
'|и взаимодействуя с глобальным объектом CEventsDB производит уведомления об обновлении данных.
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++


'[ПЕРЕМЕННЫЕ МОДУЛЯ]
   
    Dim WithEvents m_RS         As ADODB.Recordset
    '

'////////////////////////////////////////////////////////////////////////////////////////////////////////
'                                    + С В О Й С Т В А   К Л А С С А +
'////////////////////////////////////////////////////////////////////////////////////////////////////////

'Property [Recordset]   -
'********************************************************************************************* Read/Write
    Public Property Get Recordset() As ADODB.Recordset
        Set Recordset = m_RS
    End Property
   
    Public Property Set Recordset(oRS As ADODB.Recordset)
        Set m_RS = oRS
    End Property
'*********************************************************************************************



'////////////////////////////////////////////////////////////////////////////////////////////////////////
'                                      + М Е Т О Д Ы   К Л А С С А +
'////////////////////////////////////////////////////////////////////////////////////////////////////////





'////////////////////////////////////////////////////////////////////////////////////////////////////////
'                                 + О Б Р А Б О Т Ч К И   С О Б Ы Т И Й +
'////////////////////////////////////////////////////////////////////////////////////////////////////////
   
'[События рекордсета]

'[m_RS_EndOfRecordset]
'********************************************************************************************************
    Private Sub m_RS_EndOfRecordset _
                    (ByRef fMoreData As Boolean, _
                     ByRef adStatus As ADODB.EventStatusEnum, _
                     ByVal pRecordset As ADODB.Recordset _
                     )
'        Debug.Print "m_RS_EndOfRecordset"
    End Sub

'[m_RS_FetchComplete]
'********************************************************************************************************
    Private Sub m_RS_FetchComplete _
                    (ByVal pError As ADODB.Error, _
                     ByRef adStatus As ADODB.EventStatusEnum, _
                     ByVal pRecordset As ADODB.Recordset _
                     )
'        Debug.Print "m_RS_FetchComplete"
    End Sub

'[m_RS_FetchProgress]
'********************************************************************************************************
    Private Sub m_RS_FetchProgress _
                    (ByVal Progress As Long, _
                     ByVal MaxProgress As Long, _
                     ByRef adStatus As ADODB.EventStatusEnum, _
                     ByVal pRecordset As ADODB.Recordset _
                     )
'        Debug.Print "m_RS_FetchProgress"
    End Sub
   
'[m_RS_FieldChangeComplete]
'********************************************************************************************************
    Private Sub m_RS_FieldChangeComplete _
                    (ByVal cFields As Long, _
                     ByVal Fields As Variant, _
                     ByVal pError As ADODB.Error, _
                     ByRef adStatus As ADODB.EventStatusEnum, _
                     ByVal pRecordset As ADODB.Recordset _
                     )
'        Debug.Print "m_RS_FieldChangeComplete"
        If adStatus = adStatusOK Then
            Call g_oCEventsDB.UpdateField(cFields, Fields, pRecordset)
        End If
    End Sub
   
'[m_RS_MoveComplete]
'********************************************************************************************************
    Private Sub m_RS_MoveComplete _
                    (ByVal adReason As ADODB.EventReasonEnum, _
                     ByVal pError As ADODB.Error, _
                     ByRef adStatus As ADODB.EventStatusEnum, _
                     ByVal pRecordset As ADODB.Recordset _
                     )
'        Debug.Print "m_RS_MoveComplete"
    End Sub
   
'[m_RS_RecordChangeComplete]
'********************************************************************************************************
    Private Sub m_RS_RecordChangeComplete _
                    (ByVal adReason As ADODB.EventReasonEnum, _
                     ByVal cRecords As Long, _
                     ByVal pError As ADODB.Error, _
                     ByRef adStatus As ADODB.EventStatusEnum, _
                     ByVal pRecordset As ADODB.Recordset _
                     )
        If adStatus = adStatusOK Then
            Call g_oCEventsDB.UpdateRecord(adReason, cRecords, pRecordset)
        End If
    End Sub
   
'[m_RS_RecordsetChangeComplete]
'********************************************************************************************************
    Private Sub m_RS_RecordsetChangeComplete _
                    (ByVal adReason As ADODB.EventReasonEnum, _
                     ByVal pError As ADODB.Error, _
                     ByRef adStatus As ADODB.EventStatusEnum, _
                     ByVal pRecordset As ADODB.Recordset _
                     )
'        Debug.Print "m_RS_RecordsetChangeComplete"
    End Sub
   
'[m_RS_WillChangeField]
'********************************************************************************************************
    Private Sub m_RS_WillChangeField _
                    (ByVal cFields As Long, _
                     ByVal Fields As Variant, _
                     ByRef adStatus As ADODB.EventStatusEnum, _
                     ByVal pRecordset As ADODB.Recordset _
                     )
'        Debug.Print "m_RS_WillChangeField"
    End Sub
   
'[m_RS_WillChangeRecord]
'********************************************************************************************************
    Private Sub m_RS_WillChangeRecord _
                    (ByVal adReason As ADODB.EventReasonEnum, _
                     ByVal cRecords As Long, _
                     ByRef adStatus As ADODB.EventStatusEnum, _
                     ByVal pRecordset As ADODB.Recordset _
                     )
'        Call DbgRSEventMessage("RS_WillChangeRecord", adReason, cRecords, adStatus, pRecordset)
    End Sub
   
'[m_RS_WillChangeRecordset]
'********************************************************************************************************
    Private Sub m_RS_WillChangeRecordset _
                    (ByVal adReason As ADODB.EventReasonEnum, _
                     ByRef adStatus As ADODB.EventStatusEnum, _
                     ByVal pRecordset As ADODB.Recordset _
                     )
'        Debug.Print "m_RS_WillChangeRecordset"
    End Sub
   
'[m_RS_WillMove]
'********************************************************************************************************
    Private Sub m_RS_WillMove _
                    (ByVal adReason As ADODB.EventReasonEnum, _
                     ByRef adStatus As ADODB.EventStatusEnum, _
                     ByVal pRecordset As ADODB.Recordset _
                     )
'        Debug.Print "m_RS_WillMove"
    End Sub


'[События класса]

'[Class_Terminate]
'********************************************************************************************************
    Private Sub Class_Terminate()
        Set m_RS = Nothing
    End Sub


Вот собственно и все система. Обработчик событий рекордсета обрабатывает соответствующие события и дергает методы глобального объекта уведомлений. А там где нужно ловить и обрабатывать эти события нужно установить ссылку на глобальный объект уведомлений и вставить соответствующие обработчики. Кроме этого у меня сам слой доступа к данным обособлен. И если где-то мне нужен рекордсет, то я его всегда получаю через функцию NewRecordset, в которую передаются необходимые аргументы. По сути эта функция и ей подобные (а у меня их много таких) решает вопрос отсутствия нормального конструктора объектов в VB6. Так вот внутри этой функции на основании переданного текста запроса или команды порождается новый экземпляр рекордсета, устанавливаются его параметры, делается коннект к базе, подключается обработчик из подсистемы уведомлений, делается запрос и возвращается ссылка на готовый рекордсет с данными. Поэтому я не парюсь каждый раз с подпиской на события, любой полученный рекордсет уже к ней подключен и начинает рассылать уведомления.
Вот как то так.
Кстати если кто то сделал по другому, мне тоже бы интересно было знать, кто и что выдумал