Программирование для интернета с использованием COM

Обработка ошибок

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

В Visual Basic имеется система обработки ошибок, легкая в использовании и управлении. Отсутствие обработки ошибок распространяется и на программу-потребителя. В этом случае пользователь видит малоинформативное сообщение, и программа прерывает свою работу. В веб-приложении, где COM-объект используется страницей ASP, конечному пользователю отображается сообщение об ошибке, если IIS настроен на показ таких сообщений.

Каждая исключительная ситуация, имеющая место в классе clsChair, фиксируется в журнале событий и сохраняется в локальной переменной свойства ChairError. Код написан таким образом, что при получении информации об ошибке приостанавливается его работа. Обработка ошибок в классе clsChair реализована с использованием той же базовой технологии во всех функциях и подпрограммах. Обработчик ошибок устанавливается на входе в функцию или подпрограмму для перехода к определенной строке. Указываются две строки, определяющие стратегию выхода при обработке ошибок: sub_Exit_Done и sub_Error_Handler. Строка sub_Error_Handler представляет стратегию, согласно которой действия осуществляются при возникновении исключительных условий, указанных в выражении On Error. Код, следующий за строкой sub_Exit_Done, представляет собой обычную стратегию выхода функции или подпрограммы, если при работе программы не возникают исключительные ситуации. В листинге 1.5 приведена типовая структура системы обработки ошибок, примененная в классе clsClass.

Error Handling Framework

On Error GoTo Sub_Error_Handler
Const ERROR_MESSAGE_INFO = "This Function's name"

Part of the function
that actually does something
 here

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub_Exit_Done:
 'return success value
 
 On Error Resume Next
 'destroy objects
 Exit Function

Sub_Error_Handler:
 ProcessErr "message about the failure in terms of function"

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

• фиксирует информацию об ошибках в журнале событий Windows для дальнейшего анализа;
• записывает ошибки в локальную переменную класса для доступа к ней программы-потребителя.

Журнала не будет заполняться до тех пор, пока компонент не будет скомпилирован, по причине ограничения VB и мер безопасности Windows. При выполнении компонента в VB IDE журналы событий не ведутся.

В листинге 1.6 приведен код подпрограммы ProcessErr.

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'ProcessErr
'formats error and stores it in error local
'then write to event log. Event logging
'will not function in IDE - only in compiled.
'
'in: vsMessage - usually denoting function
'out: nothing
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Sub ProcessErr(ByVal vsMessage As String)
 
Const ERROR_SEPARATOR = " -- "
Const NOW_TIME_FORMAT = "yyyy mmm d hh:mm:ss"
Const A_SPACE = " "
Const ERROR_NUM = " Error #"
Const ERROR_BY = " was generated by "

Dim sDateTime As String

 'get a time data stamp
 sDateTime = CStr(Format(Now, NOW_TIME_FORMAT)) & _
 ERROR_SEPARATOR
 
 'construct the error entry
 vsMessage = sDateTime & vsMessage
 
 'add err object data to the error entry
 m_sErrorMessage = vsMessage & ERROR_NUM & Err.Number _
 & ERROR_BY & Err.Source & A_SPACE & Err.Description & vbCrLf
 
 'write to event log
 App.LogEvent m_sErrorMessage, vbLogEventTypeError
 
End Sub

ProcessErr записывает время и добавляет его к описанию ошибки. Свойства класса VB Err конкатенируются в строку, которая станет частью сообщения об ошибке, фиксируемого и сохраняемого в локальной переменной ошибки.

Запись в базу данных

Реализация функций CreateChair и OpenChair требует взаимодействия с базой данных. Функция CreateDir вставляет данные о новом объекте "стул" в базу данных, в OpenChair заполняет состояние экземпляра класса значениями, считанными из базы данных. Функция Createchair генерирует для этого объекта идентификатор ID, создает команду SQL и записывает новые значения в базу данных при помощи выражения SQL INSERT. В листинге 1.7 приведен код функции CreateChair.

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'CreateChair
'Generates a new ID, populates object with
'the new ID, writes record to DB
'
'in: nothing
'out: returns true on success and false otherwise
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Public Function CreateChair() As Boolean

On Error GoTo Sub_Error_Handler
Const ERROR_MESSAGE_INFO = "CreateChair"

Const COMMAND_PREFIX = "INSERT INTO tblChair" & _
 " ([ID], [Color]) VALUES ('"
Const COMMAND_CONJUNCTION = "', '"
Const COMMAND_SUFFIX = "')"

Dim sNewID As String
Dim sSQL As String

 'get new ID
 sNewID = CreateNewID

 'build the insert statement
 sSQL = COMMAND_PREFIX & sNewID & _
 COMMAND_CONJUNCTION & m_scolor & COMMAND_SUFFIX
 
 'perform database update
 If Not ExecuteCommand(sSQL) Then
 Err.Raise 1001, ERROR_MESSAGE_INFO, _
 "Failure updating database table for Chair ID = " & sNewID
 End If
 
 'set new ID to local setting
 m_sID = sNewID

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub_Exit_Done:
 'return success value
 CreateChair = True
 
 On Error Resume Next
 'destroy objects
 Exit Function

Sub_Error_Handler:
 ProcessErr " Failure Creating Chair. ID = " & sNewID

End Function

При вызове функции CreateNewID генерируется новый ID объекта "стул". CreateNewID вызывает функцию New(), форматирует значение в виде уникального числа и преобразует его в строку. В листинге 1.8 приведен исходный код функции CreateNewID. Данный алгоритм имеет большой недостаток. Он генерирует уникальную строку ID только в том случае, если запрос выполняется через 1 с после предыдущего запроса ID. Для получения уникальных значений необходимы более приемлемые подходы, например, использование функции глобально уникального идентификатора Windows (GUID) или других самодельных функций с генератором случайных чисел. Этот недостаток не был устранен, чтобы класс clsChair стабильно генерировал ошибку при записи информации в базу данных. Ошибка возникает из-за того, что ID объекта "стул" является главным ключом в таблице базы данных, в которой находится информация об этом объекте. Запись строки, содержащей такое же значение ID, что и записанное ранее, приведет к ошибке обновления ADO.

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'CreateNewID
'creates a new ID for a new chair
'
'in: nothing
'out: returns string ID for Chair
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Function CreateNewID() As String
 
Const NOW_TIME_FORMAT = "yyyymmddhhmmss"

Dim sDateTime As String

 'get a time data stamp
 sDateTime = CStr(Format(Now, NOW_TIME_FORMAT))
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Note: This algorithm has a huge flaw.
'It does not create unique IDs if more than
'one is requested in a given second.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
 'return value
 CreateNewID = sDateTime
 
End Function

После генерации ID конструируется выражение SQL с использованием констант, являющихся частью выражения обновления SQL, с помощью которого новые данные записываются в базу данных. Использованное значение color в действительности является локальным значением m_scolor. Свойство color, как и me.color, можно (и нужно) использовать вместо локального значения m_scolor. Если свойство color нужно подтвердить или изменить из его текущего состояния в экземпляре класса, то оно пригодится для внесения небольшого изменения в код в единственном месте, однако в этом случае потребуется изменить код и в свойстве, и в функции при помощи переменной m_scolor.

После построения команды SQL функция ExecuteCommand передает эту команду в базу данных для выполнения (см. листинг 1.9). В этой функции не предусмотрен возврат значения от события. При выполнении операции ExecuteCommand использует ADO.

Для работы с технологией ADO в набор ссылок проекта ConfigSeat нужно добавить ссылку на ADO. ADO инсталлируется при помощи пакета Microsoft Data Access Components (MDAC). ADO присутствует в ссылках Visual Basic как библиотека ActiveX Data Objects x Library, где x – номер версии MDAC. На момент написания данной книги последней версией пакета была версия 2.7, но можно использовать и версию 2.6. Если программное обеспечение располагается на узле с NT 4, то нужно использовать версию 2.6.

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'ExecuteCommand
'sends a SQL command text to the datasource
'without expectation of return value
'
'in: vsSource - SQL string to execute
'out: returns true on success, false otherwise
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Function ExecuteCommand(ByVal vsSource As String) _
As Boolean

On Error GoTo Sub_Error_Handler
Const ERROR_MESSAGE_INFO = "ExecuteCommand"

Dim cmdRequested As ADODB.Command
 
 'establish connection
 If m_Connection.State <> adStateOpen Then
 Err.Raise 1001, ERROR_MESSAGE_INFO, _ 
 "Connection Object is not open. Database connect be opened."
 End If
 
 'establish command
 Set cmdRequested = CreateObject("ADODB.Command")
 Set cmdRequested.ActiveConnection = m_Connection
 
 'set up command object
 cmdRequested.CommandType = adCmdText
 cmdRequested.CommandText = vsSource
 
 'run SQL
 cmdRequested.Execute
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub_Exit_Done:
 'return success value
 ExecuteCommand = True
 
 On Error Resume Next
 'destroy objects
 Set cmdRequested = Nothing
 Exit Function

Sub_Error_Handler:
 ProcessErr " Failure executing SQL command."

End Function

В большей части вызовов Err.Raise, выполняемых при возникновении исключительных ситуаций, выводится номер ошибки 1001. Можно указать любой номер, однако это число выбрано для простоты. Используйте числа из диапазона 1000 – 65535, предназначенного для нумерации особых ошибок. Объект ADO Command предназначен для вызова сервера базы данных. Если от объекта Command ожидается набор записей Recordset, то функция Execute возвращает набор записей ADO Recordset. Так как объект ExecuteCommand изначально не предназначен для возврата набора записей Recordset, объект Recordset, возвращаемый от объекта Command, игнорируется.

ExecuteCommand проверяет, что локальный объект подключения m_Connection установлен и жизнеспособен. После этого создается объект Command и настраивается на отправку серверу команды SQL. Если во время выполнения ExecuteCommand возникнет ошибка, обработчик ошибок зафиксирует ее и выйдет из функции, возвратив значение "ложь". Все переменные типа boolean в VB имеют значение "ложь", если им не присвоены иные значения, поэтому включите в программу код, присваивающий функции значение "истина" по достижении успеха.

Функция OpenChair открывает набора записей ADO Recordset по известному ID объекта "стул", переданного функции, и заполняет экземпляр класса по результатам перемещения к первой записи набора Recordset. В листинге 1.10 приведен исходный код функции OpenChair. Так как ID объекта "стул" является уникальным в базе данных, то ввиду ограничений работы с данными безопаснее считать, что функция возвращает только одну строку данных, и, как правило, следует использовать именно первую строку. Recordset исследуется на наличие данных с помощью проверки BOF (начало файла) и EOF (конец файла) – они не должны равняться значению "истина". Если значение параметров BOF и EOF равно "истине", то в наборе Recordset записи отсутствуют. Выполнение команды MoveFirst в пустом наборе Recordset приведет к ошибке. Свойства EOF или BOF всегда проверяются перед прохождением по набору Recordset в одном из направлений при помощи команд MoveNext или MovePrevious.

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'OpenChair
'Opens an existing record for a chair and
'populates the object with the values
'
'in: Chair ID to open
'out: returns true on success and false otherwise
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Public Function OpenChair(ID As String) As Boolean
On Error GoTo Sub_Error_Handler
Const ERROR_MESSAGE_INFO = "OpenChair"

Const COMMAND_PREFIX = "SELECT * FROM tblChair WHERE ([ID]='"
Const COMMAND_SUFFIX = "')"

Dim sSQL As String
Dim rs As ADODB.Recordset

 'build the insert statement
 sSQL = COMMAND_PREFIX & ID & COMMAND_SUFFIX
 
 'get Recordset
 Set rs = GetADORecordSet(sSQL)
 
 'make certain we got a valid Recordset
 If rs Is Nothing Then
 Err.Raise 1001, ERROR_MESSAGE_INFO, _
 "Failure Opening Chair ID = " & ID
 End If
 
 'make certain that we got a Recordset
 'with at least 1 value
 If rs.EOF And rs.BOF Then
 Err.Raise 1001, ERROR_MESSAGE_INFO, _
 "Failure - record for Chair does not exist. ID = " & ID
 End If
 
 rs.MoveFirst
 
 'set new ID to local setting
 m_sID = rs(CHAIR_ID)
 
 'set new color to local setting
 color = rs(CHAIR_COLOR)

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub_Exit_Done:
 'return success value

 OpenChair = True
 
 On Error Resume Next
 'destroy objects
 Set rs = Nothing
 Exit Function

Sub_Error_Handler:
 ProcessErr "Failure Opening Chair ID = " & ID
 
End Function

Набор Recordset, полученный для OpenChair, создан другой вспомогательной ADO-функцией – GetADORecordSet. Как и ExecuteCommand, GetADORecordSet воспринимает выражение SQL как параметр и открывает набор Recordset из источников данных в локальном экземпляре m_Connection объекта Connection. Объект набора записей передается в вызывающую функцию. В листинге 1.11 приведен исходный код функции GetADORecordSet.

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'GetADORecordSet
'Sends SQL command to datasource and returns
'an ADO Recordset to the function consumer
'

'in: vsSource - SQL string to execute
'out: returns true on success, false otherwise
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Function GetADORecordSet(ByVal vsSource As String) _
As ADODB.Recordset

On Error GoTo Sub_Error_Handler
Const ERROR_MESSAGE_INFO = "GetADORecordSet"

Dim rsRequested As ADODB.Recordset
Dim cmdRequested As ADODB.Command

 'establish connection
 If m_Connection.State <> adStateOpen Then
 Err.Raise 1001, ERROR_MESSAGE_INFO, _
 "Connection Object is not open. Database connect be opened."
 End If
 
 'establish command
 Set cmdRequested = CreateObject("ADODB.Command")
 Set cmdRequested.ActiveConnection = m_Connection
 
 'set up command object
 cmdRequested.CommandType = adCmdText
 cmdRequested.CommandText = vsSource

 'Create instance of Recordset object
 Set rsRequested = cmdRequested.Execute

 'return Recordset
 If Not rsRequested Is Nothing Then
 If rsRequested.State = adStateOpen Then
 Set GetADORecordSet = rsRequested
 Else
 'rsRequested state is not open
 Err.Raise 1001, ERROR_MESSAGE_INFO, _
 " Recordset state is not open " & vsSource
 End If
 Else
 'rsRequested is nothing error
 Err.Raise 1001, ERROR_MESSAGE_INFO, _
 " Recordset object is nothing " & vsSource
 End If

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub_Exit_Done:
 'return value
 On Error Resume Next
 'destroy objects
 Set rsRequested = Nothing
 Set cmdRequested = Nothing
 Exit Function

Sub_Error_Handler:
 ProcessErr " Failure obtaining Recordset."

End Function

Существует много возможностей по усовершенствованию функции GetADORecordSet. Одной из них является установка набора ADO Recordset как параметра функции, передаваемого в ByRef, и возврат значения "истина" или "ложь" в зависимости от результата извлечения набора Recordset. Программа расходует ресурсы на создание набора записей ADO Recordset только один раз, и функция сообщит вызывающей функции о правильности набора Recordset. Функции ExecuteCommand и GetADORecordSet можно объединить в одну.