Есть некот. программный автоматизированный комплекс по рассылке факсов
Несколько независимых программ управления рассылкой на VB работают с одной БД MSAccess
в БД есть несколько таблиц
-СписокAll -общий список
-Список1
-Список2
-Список3
... -текущие списки рассылки
-другие служебные таблицы...
Через MSAccess для БД установлены следующие свойства
Режим открытия по умолчанию -общий доступ
Блокировка по умолчанию - отсутствует
Блокировка записей при открытии БД -галочка не стоит

Принцип работы программы управления рассылкой следующий:
Из текущего списка(напр. Список 1) функцией GetZadanie (код см. ниже) считывается строчка.
По завершении сеанса досылки информация заносится в 2 списка
в Список1 sub WriteRezult (код см. ниже)
в общий СписокAll Sub RefreshMainBaza (код см. ниже)
Таких программ 5 штук. Если программа1 и программа2 работают с одним и тем же Список1,
то программа1 считывает первую строчку согласно kritBD = "Выполнено = 'нет'", а программа2 считывает
вторую строчку, т.е. в функции GetZadanie добавлено MoveNext, чем исключено одновременное обращение
к одной и той же строчке.
в одной(лишь!) -(устаревшая версия) программе использован элемент Data и DAO для отображения списка
типа Список1 в самой программе.
также к базе обращаются в автомате еще несколько служебных программок(но к другим таблицам), коды аналогичны
приведенным ниже

Суть проблемы: периодически, не так чтобы очень часто но бывает раз в несколько часов одна из программ,
управляющих факсами может вылететь, при этом пишется:
ERROR '-2147467259 (80004005)'
База данных была приведена пользователем 'admin' на компьютере Notebook в состояние,
препятствующее ее открытию и блокировке.
или
ERROR '-2147467259 (80004005)'
База данных была приведена пользователем 'admin' на компьютере D в состояние,
препятствующее ее открытию и блокировке.(P.S. Notebook -это PC, на кот.все установлено, D - это рабочий PC, находящийся в сети с Notebook, на кот.
тоже есть программы, работающие с этой БД преимущественно в ручном режиме, хотя есть и маленькие служебные,
работающие в автомате)

Скажем так, мне не столь важно, чтобы все корректно записалось, раз уж ошибка произошла,
но мне критично, чтоб программа не вылетала, а место ошибки и причину я понять не могу.
Хотя и догадываюсь, что ошибка кроеся в ф-циях, подобных тем, что приведены ниже.
ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Baza & ";Mode=Share Deny None;Persist Security Info=False"
AdoConnection.Open ConnectionString
RSBaza.CursorType = adOpenStatic
RSBaza.LockType = adLockOptimistic
Я в этих параметрах плохо разбираюсь, код естественно где-то срисовал.
Можно было бы конечно запустить программу в режиме отладки, но:
1) ошибки ждать долго и непонятно в какой именно из программ она возникнет
2) На PC где все это стоит (Notebook) установлен WIN 2003, куда VB6 не хочет устанавливаться,
в силу как это не парадоксально отсутствия в системе корректно работающей виртуальной машины DOS,
поэтому на сегодняшний день все программы пишутся и компилируются на PC 'D' , там win98, а потом уже
переносятся на win2003 server.

P.S. примеры кодов
---------------------------------------------------------
Sub RefreshMainBaza(FaxNumber As String, Logrezult As LogType5, Baza As String, Table As String)
'процедура записи данных о звонке в основную таблицу БД
'процедура обновляет статистику досылки в основной таблице БД
'для номера FaxNumber на основании данных протокола LogRezalt
Dim kritBD As String 'критерий для отбора записей из основной таблицы БД
Dim RezTM As Date 'время начала сеанса связи
Dim AdoConnection As ADODB.Connection
Dim RSBaza As ADODB.Recordset
kritBD = "Факс = '" & FaxNumber & "'"
Set AdoConnection = CreateObject("ADODB.Connection")
Set RSBaza = CreateObject("ADODB.Recordset")
ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Baza & ";Mode=Share Deny None;Persist Security Info=False"
AdoConnection.Open ConnectionString
RSBaza.CursorType = adOpenStatic
RSBaza.LockType = adLockOptimistic
RSBaza.Open "SELECT * FROM " & Table & " WHERE " & kritBD, AdoConnection
RSBaza.MoveFirst
Do While RSBaza.EOF = False
RSBaza.Fields("Досылали") = Format(Logrezult.VentData, "dd.mm.yyyy")
RSBaza.Fields("Дата") = Format(Logrezult.VentData, "dd.mm.yyyy")
RSBaza.Fields("Время") = Logrezult.VentTime
RSBaza.Fields("Длительность") = Logrezult.VentInterval
RSBaza.Fields("Результат") = Logrezult.VentResaltKod
RSBaza.Fields("Описание") = Logrezult.VentResaltText
If (Logrezult.VentResaltKod = "0") Or (Logrezult.VentResaltKod = "20") Then
'0-ок 20-ошибка разъединения
RezTM = Format(Logrezult.VentData, "dd.mm.yyyy") & " " & Logrezult.VentTime
RSBaza.Fields("Успешно") = Format(Logrezult.VentData, "dd.mm.yyyy")
RSBaza.Fields("Скорость") = Logrezult.VentSkorost
RSBaza.Fields("FaxID") = Logrezult.VentFaxID
If Period(RezTM) = "DEN" Then
RSBaza.Fields("РассылкаДень") = "ДА"
ElseIf Period(RezTM) = "NOTCH" Then
RSBaza.Fields("РассылкаНочь") = "ДА"
End If
End If
RSBaza.Update
RSBaza.MoveNext
Loop
Set RSBaza = Nothing
Set AdoConnection = Nothing
End Sub

Function GetZadanie(Baza As String, Table As String, Line As Integer) As CurrentZadanie
'берет задание из заданного списка и делает пометку в Списке,
'что задание получено данной линией
Dim kritBD As String
Dim AdoConnection As ADODB.Connection
Dim RSBaza As ADODB.Recordset
kritBD = "Выполнено = 'нет'"
Set AdoConnection = CreateObject("ADODB.Connection")
Set RSBaza = CreateObject("ADODB.Recordset")
ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Baza & ";Mode=Share Deny None;Persist Security Info=False"
AdoConnection.Open ConnectionString
RSBaza.CursorType = adOpenStatic
RSBaza.LockType = adLockOptimistic
RSBaza.Open "SELECT * FROM " & Table & " WHERE " & kritBD, AdoConnection
If RSBaza.RecordCount = 0 Then GoTo NoStr
RSBaza.MoveFirst
GetZadanie.Number = RSBaza.Fields("Номер")
GetZadanie.FaxNumer = RSBaza.Fields("Факс")
GetZadanie.Dannie = RSBaza.Fields("Данные")
RSBaza.Fields("Выполнено") = Line
RSBaza.Update
Set RSBaza = Nothing
Set AdoConnection = Nothing
Exit Function
NoStr:
GetZadanie.Number = "0"
GetZadanie.FaxNumer = ""
GetZadanie.Dannie = ""
Set RSBaza = Nothing
Set AdoConnection = Nothing
End Function

Sub WriteRezult(Baza As String, Table As String, Number As Integer, Logrezult As LogType5, test As Boolean, finish As Boolean, original As Boolean)
'делает запись в текущем списке рассылки
'test-после тестового прозвона выполнено=да
'не пишется даже при OK или ошибка=20
'finish-при финишном прозвоне выполнено=да пишется всегда
Dim kritBD As String
Dim AdoConnection As ADODB.Connection
Dim RSBaza As ADODB.Recordset
kritBD = "Номер = " & Number
Set AdoConnection = CreateObject("ADODB.Connection")
Set RSBaza = CreateObject("ADODB.Recordset")
ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Baza & ";Mode=Share Deny None;Persist Security Info=False"
AdoConnection.Open ConnectionString
RSBaza.CursorType = adOpenStatic
RSBaza.LockType = adLockOptimistic
RSBaza.Open "SELECT * FROM " & Table & " WHERE " & kritBD, AdoConnection
RSBaza.MoveFirst
'выполнено или нет
If test = True Then
If (Logrezult.VentResaltKod = "18") Or (Logrezult.VentResaltKod = "20") Or (Logrezult.VentResaltKod = "0") Then
Else
RSBaza.Fields("Выполнено") = "ДА"
End If
ElseIf finish = True Then
RSBaza.Fields("Выполнено") = "ДА"
ElseIf original = True Then
If (Logrezult.VentResaltKod = "18") Then
' RSBaza.Fields("Выполнено") = "нет"
Else
RSBaza.Fields("Выполнено") = "ДА"
End If
Else
If (Logrezult.VentResaltKod = "20") Or (Logrezult.VentResaltKod = "0") Then
RSBaza.Fields("Выполнено") = "ДА"
Else
'нельзя писать нет!-другая линия не должна звонить по той же записи!
' RSBaza.Fields("Выполнено") = "нет"
End If
End If
'дослано или нет
If (Logrezult.VentResaltKod = "20") Or (Logrezult.VentResaltKod = "0") Then
RSBaza.Fields("Дослано") = "ДА"
ElseIf (Logrezult.VentResaltKod = "18") Then
RSBaza.Fields("Дослано") = "18"
End If
'ну и собственно данные из протокола
RSBaza.Fields("Дата") = Format(Logrezult.VentData, "dd.mm.yyyy")
RSBaza.Fields("Время") = Logrezult.VentTime
RSBaza.Fields("Длительность") = Logrezult.VentInterval
RSBaza.Fields("Имя_факса") = Logrezult.VentFile
RSBaza.Fields("Страниц") = Logrezult.VentPageOK & "/" & Logrezult.VentPageFax
RSBaza.Fields("N/F") = Logrezult.VentTypeFax
RSBaza.Fields("Результат") = Logrezult.VentResaltKod
RSBaza.Fields("Скорость") = Logrezult.VentSkorost
RSBaza.Fields("Описание") = Logrezult.VentResaltText
RSBaza.Fields("FaxID") = Logrezult.VentFaxID
RSBaza.Update
Set RSBaza = Nothing
Set AdoConnection = Nothing
End Sub

А можно привести пример обработчика? И в каком месте?

Вы считаете, что вылетает именно сама программа как вещь в себе?

У меня приведенные коды могут одновременно выполняться из нескольких программ, вероятность того, что 2 программы единовременно полезут в одну и ту же запись одной таблицы в режиме правки ничтожна мала, т.к. по логике 2 программы не должны досылать факсы по одному и тому же номеру тем более одновременно (если только случайно окажутся две записи с одинаковыми факсами, да еще и досылка по этим записям одновременно одновременно закончится), вероятность одновременного обращения к разным записям даже одной таблицы гораздо больше, т.к. необходимость этих обращений возникает исходя из состояния телефонных линий, а их всего 9.

А как нибудь так сделать можно?
Т.е если вылетели, то идем на ErrHandler, ждем 1с
и повторяем попытку обращения к базе.
On error будет распространяться на все что под ним?


GetZadanie(Baza As String, Table As String, Line As Integer) As CurrentZadanie
'берет задание из заданного списка и делает пометку в Списке,
'что задание получено данной линией
Dim kritBD As String
Dim AdoConnection As ADODB.Connection
Dim RSBaza As ADODB.Recordset
goto IterOne
ErrHandler:
ltime=timer()
DoEvent
Do
If(timer()-ltime)>1 then exit do
Loop
IterOne:
On Error Goto ErrHandler
kritBD = "Выполнено = 'нет'"
Set AdoConnection = CreateObject("ADODB.Connection")
Set RSBaza = CreateObject("ADODB.Recordset")
ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Baza & ";Mode=Share Deny None;Persist Security Info=False"
AdoConnection.Open ConnectionString
RSBaza.CursorType = adOpenStatic
RSBaza.LockType = adLockOptimistic
RSBaza.Open "SELECT * FROM " & Table & " WHERE " & kritBD, AdoConnection
If RSBaza.RecordCount = 0 Then GoTo NoStr
RSBaza.MoveFirst
GetZadanie.Number = RSBaza.Fields("Номер")
GetZadanie.FaxNumer = RSBaza.Fields("Факс")
GetZadanie.Dannie = RSBaza.Fields("Данные")
RSBaza.Fields("Выполнено") = Line
RSBaza.Update
Set RSBaza = Nothing
Set AdoConnection = Nothing
Exit Function
NoStr:
GetZadanie.Number = "0"
GetZadanie.FaxNumer = ""
GetZadanie.Dannie = ""
Set RSBaza = Nothing
Set AdoConnection = Nothing
End Function

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

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

Вроде все поменял как писал в "новых" программах, за часов 12-15 "вылет" произошел только один раз, и вылетела "старая" программа, в кот.ничего не менял, кот. частично использует DAO, да и то, когда в БД Access-ом полез. С этой программой придется отдельно разбираться. Дело в том что делалась давно и вместо ф-ций там процедуры типа приведенных выше встроены не в ф-ции, а в основной код, а сама логика сложнее, чем у остальных программ.

AntonariyЛучше ...оставь просто DoEvents. А еще лучше выведи окошко с предложением повторить или продолжить. А то мало ли какая еще ошибка может возникнуть - возьмет да зациклится.

Что вообще означает DoEvents? Если правильно понял, то когда его ставишь, то компьютер лучше себя чувствует, и курсор от мышки не "бесится".
Почему не дать задержку в 1с? Надо ж процессам устаканиться перед следующей попыткой. Тем более ошибки возникают не часто, хотя лучше их обрабатывать, т.к. практически в моем случае это приводит
-к остановке рассылки факсов по вылетевшей линии (линиям)
-к не записи информации в статистику о досланном факсе, т.е. к повторной передаче через короткое время, следовательно ругань ("Что вы нам каждый день по 10 факсов шлете???")

По поводу окошек: критерий-бесперебойная работа системы, что с того что в 10 вечера выскочит окошко, а я его в 9 утра увижу. Мое постоянное присутствие рядом с PC не является обязательным параметром.
А на случай если уж совсем все плохо предусмотрена программная полная перезагрузка сервера раз в 6 часов по расписанию.

Ну почему проблема.
Она ж не для коммерческого использования. Т.е. не для продажи.
А как инструмент для работы, а то что есть глюки - ну есть.

Был задан вопрос: почему возникает ошибка при совместном доступе к БД?

Ответ был по сути дан на другой вопрос: как обойти ошибку и свести к минимуму потери.

По сути это решение, а академического интереса у меня здесь особо нет.

По сути:
Antonariyquot Было дано комплексное решение:Поставь перед апдейтом обработчик, который обработает эту ошибку, подождет и попробует еще раз.
Что и было сделано
Antonariyquot а глюки будут только множиться.
И описанные глюки исчезли.
Antonariyquot А лучше перед каждым апдейтом запускай транзакцию, тогда все апдейты выстроятся в очередь и следующий не будет пытаться лезть в записи, заблокированные предыдущим.
А вот здесь можно поподробней. Я так понимаю это устранение причины. Это мне больше нравится. Что такое транзакция , как это в терминах кода VB выглядит?

P.S.И не ругайтесь вы на меня. Я в програмировании не профессионал, а любитель. И программы я пишу исключительно для себя и коллег. Обработка ошибок вещь нужная. Но их не всегда можно предусмотреть. Изначально вообще был DOS-овский bat-файл, кот.рассылал факсы по заданному списку. Потом появилась БД, была написана одна линейная (для одной телефонной линии) программа,управляющая драйвером VentaFax, и этих ошибок в принципе возникнуть не могло - их обработку незачем было писать, потом линий стало две, потом добавилать SIP-телефония линий стало 4, сейчас у меня их 9, добавилось программное управление Microsoft Fax via VB, модули управления двумя sip-адаптерами через com-port-ы (MSComm), система усложняется, появляются проблемы, их надо решать, они решаются. Надеюсь, Вы со мной согласитесь.

Что за загадочный объект "cn"
Наверно тогда уж

И можно на пальцах? Правильно я понимаю, что BeginTrans и CommitTrans страхуют заключенный между ними update от описанных ошибок?

Или ошибка все же может произойти?
А RollbackTrans вернет тогда программу к тому месту, где находится BeginTrans?
И эффект будет тот же, что и в случае Resume IterOne?

Описание я прочитал, но все же не совсем ясно: