3. Преобразование ADO в XML

Теперь, когда вы поняли основы XML, давайте создадим элемент управления ActiveX, который будет конвертировать набор данных ADO в XML формат. Цель в том, чтобы получить наименования книг из таблицы Titles базы данных Pubs и вернуть их в формате XML. Результат, который получится я буду использовать в своей следующей статье. Вы можете сказать, ADO имеет свои собственные методы для сохранения результата в формате XML, правильно? Да, но если доверить это ADO, то в итоге я получу XML файл в таком ужасном формате, что с ним невозможно будет работать. ADO создаст XML файл с использованием пространства имен, а мне сейчас это совсем не нужно. Во-вторых, ADO создаст XML файл, который будет представлен в форме атрибутов. Иными словами, каждая запись станет элементом и каждое поле - атрибутом:

<xml xmlns:s='uuid:BDC6E3F0-6DA3-11d1-A2A3-00AA00C14882' xmlns:dt='uuid:C2F41010-65B3-11d1-A29F-00AA00C14882' xmlns:rs='urn:schemas-microsoft-com:rowset' xmlns:z='#RowsetSchema'> <s:Schema id='RowsetSchema'> <s:ElementType name='row' content='eltOnly'> <s:AttributeType name='title_id' rs:number='1' rs:writeunknown='true'> <s:datatype dt:type='string' rs:dbtype='str' dt:maxLength='6' rs:maybenull='false'/> </s:AttributeType> <s:AttributeType name='title' rs:number='2' rs:writeunknown='true'> <s:datatype dt:type='string' rs:dbtype='str' dt:maxLength='80' rs:maybenull='false'/> </s:AttributeType> <s:AttributeType name='type' rs:number='3' rs:writeunknown='true'> <s:datatype dt:type='string' rs:dbtype='str' dt:maxLength='12' rs:fixedlength='true' rs:maybenull='false'/> </s:AttributeType> <s:AttributeType name='price' rs:number='4' rs:nullable='true' rs:writeunknown='true'> <s:datatype dt:type='number' rs:dbtype='currency' dt:maxLength='8' rs:precision='19' rs:fixedlength='true'/> </s:AttributeType> <s:AttributeType name='ytd_sales' rs:number='5' rs:nullable='true' rs:writeunknown='true'> <s:datatype dt:type='int' dt:maxLength='4' rs:precision='10' rs:fixedlength='true'/> </s:AttributeType> <s:AttributeType name='notes' rs:number='6' rs:nullable='true' rs:writeunknown='true'> <s:datatype dt:type='string' rs:dbtype='str' dt:maxLength='200'/> </s:AttributeType> <s:AttributeType name='pubdate' rs:number='7' rs:writeunknown='true'> <s:datatype dt:type='dateTime' rs:dbtype='timestamp' dt:maxLength='16' rs:scale='3' rs:precision='23' rs:fixedlength='true' rs:maybenull='false'/> </s:AttributeType> <s:extends type='rs:rowbase'/> </s:ElementType> </s:Schema> <rs:data> <z:row title_id='BU1032' title='The Busy Executive's Database Guide' type='business ' price='19.99' ytd_sales='4095' notes='An overview of available database systems with emphasis on common business applications. Illustrated.' pubdate='1991-06-12T00:00:00'/> <z:row title_id='BU1111' title='Cooking with Computers: Surreptitious Balance Sheets' type='business ' price='11.95' ytd_sales='3876' notes='Helpful hints on how to use your electronic resources to the best advantage.' pubdate='1991-06-09T00:00:00'/> </rs:data> </xml>

А мне бы хотелось получить XML файл в форме элементов, где каждая запись, содержалась бы в теге <BOOK>, и каждое поле было бы элементом внутри тега <BOOK>. Синтаксис моей XML строки был бы таким:

<TITLES> <BOOK>data from table <FIELD prettyname="Book identification number" tablename="titles" columnname="title_id" datatype="number" filter="">data from table</FIELD> <FIELD prettyname="Title of the book" tablename="titles" columnname="title" datatype="text" filter="">data from table</FIELD> <FIELD prettyname="Type of book" tablename="titles" columnname="type" datatype="text" filter="">data from table</FIELD> <FIELD prettyname="Price of the book" tablename="titles" columnname="price" datatype="number" filter="">data from table</FIELD> <FIELD prettyname="Year todate sales" tablename="titles" columnname="ytd_sales" datatype= "number" filter= "">datafrom table</FIELD> <FIELD prettyname="Datepublished" tablename= "titles" columnname="pubdate" datatype="date" filter= "">datafromtable</FIELD> </BOOK> </TITLES>

Кстати, то, что я только что сделал, это создал схему для моей XML строки. Теперь, если мне нужно сверить структуру XML документа со схемой, все что мне останется сделать, это преобразовать схему в правильный формат. То есть в синтаксис DTD или XDR. Заметьте, что я добавил некоторые атрибуты к каждому элементу <FIELD>. Одна из причин этого в том, что эта информация может быть использована клиентом. Prettyname могут быть использованы как метки данных. Атрибут datatype мог бы быть использован для проверки данных на стороне клиента. Но чтобы быть честным, истина причина того, что появились эти атрибуты в том, что они имеют особое назначение в шаблоне XSL фала, который я часто использую для построения секции where SQL запросов. Может быть, я скоро опубликую статью, демонстрирующую этот подход. Шаблон на самом деле очень полезный. Когда XML структура применяется к данным из таблицы Titles, результат будет выглядеть следующим образом:

<TITLES> <BOOK>The Busy Executive's Database Guide <FIELD prettyname="Title Identification Number" tablename="titles" gcolumnname="title_id" datatype="number" gfilter="">BU1032</FIELD> <FIELD prettyname="Title of the Book" tablename="titles" gcolumnname="title" datatype="text" gfilter=""> The Busy Executive's Database Guide</FIELD> <FIELD prettyname="Type of Book" tablename="titles" gcolumnname="type" datatype="text" gfilter="">business</FIELD> <FIELD prettyname="Price of the Book" tablename="titles" gcolumnname="price" datatype="number" gfilter="">19.99</FIELD> <FIELD prettyname="Year to date sales" tablename="titles" gcolumnname="ytd_sales" datatype="number" gfilter="">4095</FIELD> <FIELD prettyname="Notes about the book" tablename="titles" gcolumnname="notes" datatype="memo" gfilter=""> An overview of available database systems with emphasis on common business applications. Illustrated.</FIELD> <FIELD prettyname="Date Published" tablename="titles" gcolumnname="pubdate" datatype="date" gfilter="">6/12/1991</FIELD> </BOOK> <BOOK>Cooking with Computers: Surreptitious Balance Sheets <FIELD prettyname="Title Identification Number" tablename="titles" gcolumnname="title_id" datatype="number" gfilter="">BU1111</FIELD> <FIELD prettyname="Title of the Book" tablename="titles" gcolumnname="title" datatype="text" gfilter="">Cooking with Computers: Surreptitious Balance Sheets</FIELD> <FIELD prettyname="Type of Book" tablename="titles" gcolumnname="type" datatype="text" gfilter="">business</FIELD> <FIELD prettyname="Price of the Book" tablename="titles" gcolumnname="price" datatype="number" gfilter="">11.95</FIELD> <FIELD prettyname="Year to date sales" tablename="titles" gcolumnname="ytd_sales" datatype="number" gfilter="">3876</FIELD> <FIELD prettyname="Notes about the book" tablename="titles" gcolumnname="notes" datatype="memo" gfilter="">Helpful hints on how to use your electronic resources to the best advantage.</FIELD> <FIELD prettyname="Date Published" tablename="titles" gcolumnname="pubdate" datatype="date" gfilter="">6/9/1991</FIELD> </BOOK> </TITLES>

Теперь я получил что-то, с чем можно работать!

Листинг 1 - CUP.XML

<?xml version="1.0"?> <CUP> <MATERIAL transparent="yes">glass</MATERIAL> <HEIGHT units="inches">6</HEIGHT> <VOLUME units="ounces">16</VOLUME> <CONTENTS> <SOLID qty="2">ice cube</SOLID> <SOLID qty="1">straw</SOLID> <LIQUID qty="3" units="ounces">water</LIQUID> <OTHER qty="0"/> </CONTENTS> <LID>yes</LID> </CUP>

Листинг 2 - Загрузка Cup.xml в объектную модель документов

Dim xmlDoc As MSXML2.DOMDocument30 Set xmlDoc = New DOMDocument30 xmlDoc.async = False xmlDoc.validateOnParse = False xmlDoc.Load ("c:inetpubwwwrootxmlcup.xml") MsgBox xmlDoc.xml Dim objNode As IXMLDOMNode Dim objListOfNodes As IXMLDOMNodeList xmlDoc.setProperty "SelectionLanguage", "XPath" MsgBox "Your cup contains the following items" Set objListOfNodes = xmlDoc.selectNodes("//CONTENTS/*[@qty>0]") For Each objNode In objListOfNodes MsgBox objNode.Text Next Set objNode = xmlDoc.selectSingleNode("/CUP/LID") If objNode.Text = "yes" Then MsgBox "We have a lid" Else MsgBox "No lid on this cup" End If

Листинг 3 - Элемент управления ActiveX: ADO в XML (WebClass.dll)(xmlControl.cls)

Option Explicit 'Declare Database variables Private m_dbConnection As New ADODB.Connection Private m_dbCommand As ADODB.Command Private m_adoRs As ADODB.Recordset Private m_adoErrors As ADODB.Errors Private m_adoErr As Error Public nCommandTimeOut As Variant Public nConnectionTimeOut As Variant Public strConnect As Variant Public strAppName As String Public strLogPath As String Public strDatabase As String Public strUser As String Public strPassword As String Public strServer As String Public strVersion As String Public lMSADO As Boolean 'Private Global Variables Private gnErrNum As Variant Private gstrErrDesc As Variant Private gstrErrSrc As Variant Private gstrDB As String Private gstrADOError As String Private Const adLeonNoRecordset As Integer = 129 Private gtableName(6) As String Private gcolumnName(6) As String Private gprettyName(6) As String Private gdatatype(6) As String Private gfilter(6) As String Private Function OpenDatabase() If Len(strConnect) = 0 Then 'устанавливаем значения по умолчанию If Len(strDatabase) = 0 Then strDatabase = "pubs" End If If nConnectionTimeOut = 0 Then nConnectionTimeOut = 600 End If If nCommandTimeOut = 0 Then nCommandTimeOut = 600 End If If Len(strAppName) = 0 Then strAppName = "xmlControl" End If If Len(strUser) = 0 Then strUser = "sa" End If If Len(strPassword) = 0 Then strPassword = "" End If strConnect = "Provider=SQLOLEDB.1; " & _ "Application Name=" & strAppName & _ "; Data Source=" & strServer & "; Initial Catalog=" & strDatabase & "; " & _ " User ID=" & strUser & "; Password=" & strPassword & ";" End If 'подключаемся к SQL Server и открываем базу данных On Error GoTo SQLErr 'Включаем обработчик ошибок With m_dbConnection .ConnectionTimeout = nConnectionTimeOut .CommandTimeout = nCommandTimeOut .Open strConnect 'открываем базу данных, используя строку подключения End With On Error GoTo 0 'выключаем обработчик ошибок OpenDatabase = True 'база данных открыта успешно Exit Function SQLErr: Call logerror("OPEN") OpenDatabase = False End Function Private Function BuildSQLwhere(tmpWhere) As String 'Это на будущее End Function Public Function GetTitlesXML(Optional xmlWhere As Variant) As String Dim whereClause As String Dim strSQL As String Call OpenDatabase 'открываем базу данных pubs If IsMissing(xmlWhere) Then 'когда запрос не прошел whereClause = "" Else whereClause = BuildSQLwhere(xmlWhere)'конвертируем запрос в правильный sql End If 'инициализируем sql выражение которое будет запрашивать заголовки книг strSQL = "select title_id,title,type,price,ytd_sales,notes,pubdate from titles " & whereClause Call NewRecordSet 'создаем набор данных 'устанавливаем cursorlocation m_adoRs.CursorLocation = adUseClient 'открываем набор записей m_adoRs.Open strSQL, m_dbConnection, adOpenForwardOnly, adLockReadOnly, adCmdText 'отключаемся от набора данных Set m_adoRs.ActiveConnection = Nothing On Error GoTo 0 'выключаем обработчик ошибок 'закрываем базу данных и освобождаем подключение Call CloseDatabase If m_adoRs.EOF Then GetTitlesXML = "" 'запрос не вернул ни одного значения Else If lMSADO Then GetTitlesXML = msado(m_adoRs) 'конвертируем набор данных в Microsoftado-->xml Else GetTitlesXML = ADOtoXML(m_adoRs, True) 'convert the ado recordset to custom xml End If End If 'закрываем набор данных Call CloseRecordset Exit Function SQLErr: Call logerror(strSQL) End Function Private Function ADOtoXML(tmprs As ADODB.Recordset, tmpMP As Boolean) As String Dim adoFields As ADODB.Fields 'объявляем коллекцию для хранения полей Dim adoField As ADODB.Field 'используется для получения каждого поля из коллекции Dim xmlDoc As msxml2.DOMDocument30 Dim tmpLine As String 'хранит xml представление каждой книги Dim tmpXML As String 'служит для конкатенации xml строк Dim i As Integer If tmprs.EOF Then 'запрос не вернул ни одну запись ADOtoXML = "" Exit Function Else Set adoFields = tmprs.Fields 'создаем коллекцию полей End If tmpXML = "<TITLES>" 'все книги будет заключены в тег <TITLES> Do Until tmprs.EOF 'цикл по каждой строке в наборе данных i = 0 ' I - индекс ado поля, который начинается с 0 - первое поле будет field(0) tmpLine = "<BOOK>" & tmprs("title") & vbCrLf For Each adoField In adoFields 'цикл по всем полям 'строим xml тег <FIELD> и его атрибуты для текущего поля tmpLine = tmpLine & "<FIELD " tmpLine = tmpLine & "prettyname=""" & gprettyName(i) & """ " tmpLine = tmpLine & "tablename=""" & gtableName(i) & """ gcolumnname=""" & adoField.Name & """ " tmpLine = tmpLine & "datatype=""" & gdatatype(i) & """ gfilter=""""" tmpLine = tmpLine & ">" & adoField.Value tmpLine = tmpLine & "</FIELD>" & vbCrLf i = i + 1 'переходим на следующее поле Next tmpXML = tmpXML & tmpLine & "</BOOK>" & vbCrLf 'закрывающий тег после последнего поля tmprs.MoveNext 'следующий заголовок Loop Set adoField = Nothing 'уничтожаем объект-поле Set adoFields = Nothing 'уничтожаем объект-коллекцию полей tmpXML= tmpXML & "<?xml version="1.0"?></TITLES>" & vbCrLf 'закрывающий тег </TITLES> Set xmlDoc = New msxml2.DOMDocument30 'создание xmlDOM xmlDoc.async = False 'ждем когда документ загрузится xmlDoc.validateOnParse = False 'не сверяемся со схемой xmlDoc.loadXML(tmpXML) 'загружаем строку в объектную модель документов On Error Resume Next 'если файл не существует, то обрабатываем эту ошибку Kill("c:tempcustom.xml") 'стираем файл если он существует On Error GoTo 0 'говорим обработчику ошибок прерываться при обнаружении ошибки xmlDoc.save ("c:tempcustom.xml") 'сохраняем xml в файл ADOtoXML=xmlDoc.xml 'возвращает xml строку Set xmlDoc=Nothing 'уничтожаем объектную модель документов End Function Private Function msado(tmprs As ADODB.Recordset) As String Dim xmlDoc As msxml2.DOMDocument30 On Error Resume Next 'если файла не существует, получаем ошибку Kill ("c:tempmsado.xml") 'стираем файл, если он существует On Error GoTo 0 ' говорим обработчику ошибок прерываться при обнаружении ошибки tmprs.save "c:tempmsado.xml", adPersistXML ' сохраняем xml в файл Set xmlDoc = New msxml2.DOMDocument30 'создаем объектную модель документов xml xmlDoc.async = False 'ждем загрузки xml документа xmlDoc.validateOnParse = False 'не сверяемся со схемой xmlDoc.Load ("C:tempmsado.xml") 'загружаем файл в объектную модель документов msado = xmlDoc.xml 'возвращаем xml строку Set xmlDoc = Nothing 'уничтожаем объектную модель документов End Function Private SubCloseRecordset() 'закрываем набор данных m_adoRs.Close Set m_adoRs =Nothing End Sub Private Sub NewRecordSet() Set m_adoRs= Nothing Set m_adoRs=New ADODB.Recordset End Sub Private Sub CloseDatabase() m_dbConnection.Close Set m_dbConnection =Nothing End Sub Private Sub logerror(errSQL As String) Dim hFile As Integer Dim expFile As String On Error GoTo 0 gnErrNum = Err.Number gstrErrDesc =Err.Description gstrErrSrc = Err.Source Set m_adoErrors = m_dbConnection.Errors For Each m_adoErr In m_adoErrors gstrADOError = m_adoErr.Description & "," & CStr(m_adoErr.NativeError) _ & "," & CStr(m_adoErr.Number) & "," & m_adoErr.Source _ & "," & CStr(m_adoErr.SQLState) Next hFile =FreeFile If Len(strLogPath) = 0 Then strLogPath = "C:temp" End If expFile = strLogPath & strAppName & ".err" Open expFile For Append As #hFile Print #hFile,"**********************************" Print #hFile, Now() Print#hFile, "**********************************" Print #hFile,"Subroutine: " & tmpPro Print #hFile, "Error Number:" & gnErrNum Print#hFile, "Error Description: " & gstrErrDesc Print #hFile, "Error Source:" & gstrErrSrc Print #hFile, "Ado error String: " & gstrADOError Print #hFile, "Bad SQL: " & errSQL Close #hFile End Sub Private Sub Class_Initialize() strVersion = "xmlControl Version 1.1" 'title_id,title,type,price,ytd_sales,notes,pubdate gtableName(0) = "titles" gcolumnName(0) = "title_id" gprettyName(0) = "Title Identification Number" gdatatype(0) = "number" gfilter(0) = "" gtableName(1) = "titles" gcolumnName(1) = "title" gprettyName(1) = "Title of the Book" gdatatype(1) = "text" gfilter(1) = "" gtableName(2) = "titles" gcolumnName(2) = "type" gprettyName(2) = "Type of Book" gdatatype(2) = "text" gfilter(2) = "" gtableName(3) = "titles" gcolumnName(3) = "price" gprettyName(3) = "Price of the Book" gdatatype(3) = "number" gfilter(3) = "" gtableName(4) = "titles" gcolumnName(4) = "ytd_sales" gprettyName(4) = "Year to date sales" gdatatype(4) = "number" gfilter(4) = "" gtableName(5) = "titles" gcolumnName(5) = "notes" gprettyName(5) = "Notes about the book" gdatatype(5) = "memo" gfilter(5) = "" gtableName(6) = "titles" gcolumnName(6) = "pubdate" gprettyName(6) = "Date Published" gdatatype(6) = "date" gfilter(6) = "" End Sub

Листинг 4 - Тестовое приложение на VB для проверки WebClass

Private Sub Command1_Click() Dim objWC As xmlControl Dim xml As String Set objWC = New xmlControl objWC.strDatabase = "pubs" objWC.strServer = "ltweb" objWC.strUser = "sa" objWC.strPassword = "" objWC.lMSADO = Option2.Value objWC.strAppName = "Article1" Text1.Text = objWC.getTitlesXML End Sub

Листинг 5 - ASP для тестирования WebClass

<%@ Language=VBScript %> <% 'Используем WebClass элемента управления ActiveX чтобы вернуть xml в браузер ' 'до того, как со страницей можно будет работать, WebClass.dll должен быть зарегистрирован 'на вэб-сервере. 'Анализатор microsoft xml версии 3.0 (msxml3.dll) тоже должен быть зарегистрирован ' set objWC = Server.CreateObject("WebClass.xmlControl") objWC.strDatabase = "pubs" objWC.strServer = "ltweb" 'замените ltweb именем вашего SQL сервера objWC.strUser ="sa" 'замените sa именем пользователя вашего SQL сервера objWC.strPassword="" 'сюда введите пароль для этого пользователя objWC.strAppName="Article1" objWC.lMSADO=false 'true вернет microsoft ado-->xml 'false вернет пользовательский xml ' Response.ContentType="text/xml" 'устанавливаем тип содержимого для браузера Response.write objWC.getTitlesXML 'получаем the xml отображаем его ' set objWC=nothing 'уничтожаем объект %>