ADO数据与XML数据间的转换的类(ASP实现)

当对现有数据库的数据进行分析时，经常需要对某一部分的数据进行分析.此时，使用

1.SQL查询分析器？

但其往往不直观，查找某个关键字又需要重新执行新的SQL.

2.SQLXML模板？

但又不一定有权限建立新的虚拟目录，且某些SQL语句SQLXML模板不支持

数据拆离时也有相似问题。

尤其当不同网络，不同环境，需要重新导入数据，进行分析或拆离，困难尤为明显。

能不能有一种方法，可以将数据脱离于数据库进行分析，需要时再导入到数据库中？

XML是个很好的选择！

ADO本身支持数据到XML的转换，只需要对其格式进行解析，成为自己的XML文件通用格式，就可以进行本地分析

而对通用XML格式进行数据库映射，就可完成数据重新导入数据库的工作.

下面是一个ADO数据(表的基本数据)与XML数据间的相互转换的类(ASP实现)，初步完成表数据的导入、导出。

通用表间关系映射(通过XSD描述),考虑之中，希望各位赐教指点，不胜感激.

一个调用类的例子：

example.asp

Dim aSQL(1,1)

Dim oXMLData

'====== 连接数据库过程 ======

'获得数据库连接对象 oDbConn

'====== 连接数据库过程 ======

aSQL(0,0) = "PubLable"

aSQL(0,1) = "Select * from PubLabel where cLabelName like '%abc%' Order by nLabelID"

aSQL(1,0) = "PubUser"

aSQL(1,1) = "Select * from PubUser where cUserName like '%abc%' Order by nUserID"

set oXMLData = New TransformData

Call Export()

'Call Import()

set oXMLData = nothing

' // 当对象属性有默认值(default())时,可以不用在赋值

Sub Export() ' // 导出数据

oXMLData.aSQlData = aSQL

' 必须 2维SQL语句数组

oXMLData.bIsSave = 1

' default(1) 是否保存为XML文件

oXMLData.bIsOutput = 1

' default(0) 是否显示XML数据

oXMLData.sSaveFileName = "Data.xml"

' default(当前时间加随机数) 如果保存XML数据，XML文件名称

oXMLData.sSaveFilePath = ""

' default("") 如果保存XML数据，XML文件路径(相对路径)

oXMLData.sEncoding = "gb2312"

' default("gb2312") XML文件编码类型

oXMLData.Export (oDbConn)

' // 导出数据过程

IF (oXMLData.nErrCode<>0) Then ' nErrCode(错误代码)为0，运行成功

Response.Write oXMLData.GetErrExegesis(oXMLData.nErrCode)

'nErrCode(错误代码)，通过方法GetErrExegesis() 获得注释

End IF

End Sub

Sub Import() ' // 导入数据

oXMLData.sXMLFile = "Data.xml" ' 必须数据源XML文件(包含相对路径)

oXMLData.sVacancyCols = "nLabelID" ' 必须指定某些字段的值可以不导入(屏蔽字段)

' 格式 "nID,dDate" (以‘，’分隔字段)

oXMLData.Import (oDbConn)

IF (oXMLData.nErrCode=0) Then

Response.Write "数据导入成功！"

Else

Response.Write oXMLData.GetErrExegesis(oXMLData.nErrCode)

End IF

End Sub

类的代码：

TransformData.asp

Class TransformData

'*****************************************************

' 创建人 : moonpiazza

' 日期 : 2003.5.21

' 描述 : ADO数据与XML数据间的转换(ASP实现)

' 版本 : 1.0

' 功能 : ADO数据(表的基本数据)与XML数据间的相互转换

' 待改进 : 表间数据的关联性(通用)，数据量大时速度问题

' 版权 : 欢迎改进，翻版不究 :_)

'*****************************************************

' 公共方法： Export, Import, GetErrExegesis

'*****************************************************

'============================= 公共变量 End =============================

Private m_oXMLDOM

Private m_oXSLDOM

'============================= 公共变量 Begin =============================

'============================= 错误代码定义 Begin =============================

Private m_nErrCode_NotArray

Private m_nErrCode_XMLDOM

Private m_nErrCode_ReadData

Private m_nErrCode_WriteData

Private m_nErrCode_Save

Private m_nErrCode_EnsFile

Private m_nErrCode_ErrFile

'============================= 错误代码定义 End =============================

'============================= 属性定义 Begin =============================

Private m_aSQlData

Private m_bIsSave

Private m_bIsOutput

Private m_sSaveFileName

Private m_sSaveFilePath

Private m_sXMLFile

Private m_sVacancyCols

Private m_nErrCode

Private m_sEncoding

Private m_sImportSQL

'*****************************************************

' 属性： aSQlData

' 状态：可写

' 类型： 2维数组

' 描述： SQL语句数组，1维是表名称，2维是相应SQL语句

'*****************************************************

Public Property Let aSQlData(ByRef p_aSQlData)

m_aSQlData = p_aSQlData

End Property

'*****************************************************

' 属性： bIsSave

' 状态：可写

' 类型：数字(0,1) default(1)

' 描述：导出数据时，是否保存为XML文件

'*****************************************************

Public Property Let bIsSave(ByRef p_bIsSave)

m_bIsSave = Cint(p_bIsSave)

End Property

'*****************************************************

' 属性： bIsOutput

' 状态：可写

' 类型：数字(0,1) default(0)

' 描述：导出数据时，是否显示XML数据

'*****************************************************

Public Property Let bIsOutput(ByRef p_bIsOutput)

m_bIsOutput = Cint(p_bIsOutput)

End Property

'*****************************************************

' 属性： sSaveFileName

' 状态：可写，可读

' 类型：字符串 default(GetRndFileName())

' 描述：导出数据时，如果保存XML数据，XML文件名称

'*****************************************************

Public Property Let sSaveFileName(ByRef p_sSaveFileName)

m_sSaveFileName = p_sSaveFileName

End Property

Public Property Get sSaveFileName()

sSaveFileName = m_sSaveFileName

End Property

'*****************************************************

' 属性： sSaveFilePath

' 状态：可写，可读

' 类型：字符串 default("")

' 描述：导出数据时，如果保存XML数据，XML文件路径(相对路径)

'*****************************************************

Public Property Let sSaveFilePath(ByRef p_sSaveFilePath)

m_sSaveFilePath = p_sSaveFilePath

End Property

Public Property Get sSaveFilePath()

sSaveFilePath = m_sSaveFilePath

End Property

'*****************************************************

' 属性： sXMLFile

' 状态：可写

' 类型：字符串

' 描述：导入数据时，数据源XML文件(包含相对路径)

'*****************************************************

Public Property Let sXMLFile(ByRef p_sXMLFile)

m_sXMLFile = p_sXMLFile

End Property

'*****************************************************

' 属性： sVacancyCols

' 状态：可写

' 类型：字符串 default("")

' 格式 "nID,dDate" (以‘，’分隔字段)

' 描述：导入数据时，指定某些字段的值可以不导入(屏蔽字段)

'*****************************************************

Public Property Let sVacancyCols(ByRef p_sVacancyCols)

m_sVacancyCols = "," & p_sVacancyCols & ","

End Property

'*****************************************************

' 属性： nErrCode

' 状态：可读

' 类型：数字 default(0)

' 描述：错误代码，可通过方法GetErrExegesis(ByRef p_nErrCode) 获得注释

'*****************************************************

Public Property Get nErrCode()

nErrCode = m_nErrCode

End Property

'*****************************************************

' 属性： sEncoding

' 状态：可写

' 类型：字符串 default("gb2312")

' 描述： XML文件编码类型

'*****************************************************

Public Property Let sEncoding(ByRef p_sEncoding)

m_sEncoding = p_sEncoding

End Property

'*****************************************************

' 属性： sImportSQL

' 状态：可读

' 类型：字符串 default("gb2312")

' 描述：导入数据时，生成的SQL语句

'*****************************************************

Public Property Get sImportSQL()

sImportSQL = m_sImportSQL

End Property

'============================= 属性定义 End =============================

'*****************************************************

' 初始化类

'*****************************************************

Private Sub Class_Initialize()

Server.ScriptTimeout = 1000

m_nErrCode_NotErr = 0

m_nErrCode_NotArray = 1

m_nErrCode_XMLDOM = 2

m_nErrCode_ReadData = 3

m_nErrCode_WriteData= 4

m_nErrCode_Save = 5

m_nErrCode_EnsFile = 6

m_nErrCode_ErrFile = 7

m_bIsSave = 1

m_bIsOutput = 0

m_sSaveFilePath = ""

m_sSaveFileName = ""

m_sXMLFile = ""

m_sVacancyCols = ""

m_nErrCode = m_nErrCode_NotErr

m_sEncoding = "gb2312"

End Sub

'*****************************************************

' 注销类

'*****************************************************

Private Sub Class_Terminate()

Set m_oXMLDOM = Nothing

Set m_oXSLDOM = Nothing

End Sub

'============================= 数据导出 Begin =============================

'*****************************************************

' 过程： Export(ByRef p_oDbConn)

' 描述：导出数据

' 参数：

' p_oDbConn：数据库连接对象

'*****************************************************

Public Sub Export(ByRef p_oDbConn)

Dim nI, nMaxI

Dim sTableName, sSQL

Dim sDataXML, sXSLStr

Dim sXMLStr

If (Not IsArray(m_aSQlData)) Then

m_nErrCode = m_nErrCode_NotArray

Exit Sub

End If

ON ERROR RESUME NEXT

Set m_oXSLDOM = Server.CreateObject("Microsoft.XMLDOM")

Set m_oXMLDOM = Server.CreateObject("Microsoft.XMLDOM")

If Err.Number <>0 Then

m_nErrCode = m_nErrCode_XMLDOM

Exit Sub

End If

sXSLStr = GetXSL()

m_oXMLDOM.async = false

m_oXSLDOM.async = false

m_oXSLDOM.loadxml(sXSLStr)

sDataXML = "<?xml version='1.0' encoding='" & m_sEncoding & "'?>"

sDataXML = sDataXML & "<DataBase>"

nMaxI = Ubound(m_aSQlData, 1)

For nI=0 To nMaxI

sTableName = m_aSQlData(nI, 0)

If (Len(sTableName) > 0) Then

sSQL = m_aSQlData(nI, 1)

sXMLStr = GetDataXML(sTableName, sSQL, p_oDbConn)

IF (m_nErrCode > m_nErrCode_NotErr) Then

Exit Sub

End IF

sDataXML = sDataXML & sXMLStr

End If

sDataXML = sDataXML & "</DataBase>"

IF (m_bIsOutput) Then

Call ResponseXML(sDataXML)

End IF

IF (m_bIsSave) Then

Call SaveDataXML(sDataXML)

End IF

End Sub

'*****************************************************

' 函数： GetRndFileName()

' 描述：获得随机名称，由当前时间和7位随机数字构成

'*****************************************************

Private Function GetRndFileName()

Dim nMax, nMin

Dim sRnd, sDate

Randomize

nMin = 1000000

nMax = 9999999

sRnd = Int( ( (nMax - nMin + 1) * Rnd ) + nMin)

sDate = Replace( Replace( Replace( now(), "-", "") , ":", ""), " ", "")

GetRndFileName = "_" & sDate & sRnd & ".xml"

End Function

'*****************************************************

' 函数： GetXSL()

' 描述：获得XSL文件字符串

'*****************************************************

Private Function GetXSL()

Dim sXSLStr

sXSLStr = ""

sXSLStr = sXSLStr & "<?xml version='1.0' encoding='" & m_sEncoding & "'?>"

sXSLStr = sXSLStr & "<xsl:stylesheet version='1.0' xmlns:xsl='http://www.w3.org/1999/XSL/Transform' 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'>"

sXSLStr = sXSLStr & "<xsl:output omit-xml-declaration='yes'/>"

sXSLStr = sXSLStr & "<xsl:template match='/'>"

sXSLStr = sXSLStr & "<xsl:for-each select='/xml/rs:data/z:row'>"

sXSLStr = sXSLStr & "<xsl:element name='Row'>"

sXSLStr = sXSLStr & "<xsl:for-each select='@*'>"

sXSLStr = sXSLStr & "<xsl:attribute name='{name()}'>"

sXSLStr = sXSLStr & "<xsl:value-of select='.'/>"

sXSLStr = sXSLStr & "</xsl:attribute>"

sXSLStr = sXSLStr & "</xsl:for-each>"

sXSLStr = sXSLStr & "</xsl:element>"

sXSLStr = sXSLStr & "</xsl:for-each>"

sXSLStr = sXSLStr & "</xsl:template>"

sXSLStr = sXSLStr & "</xsl:stylesheet>"

GetXSL = sXSLStr

End Function

'*****************************************************

' 函数： GetDataXML(ByRef p_sTableName, ByRef p_sSQL, ByRef p_oDbConn)

' 描述：执行单条SQL，获得数据转换后的XML

' 参数：

' 1.p_sTableName ：表的名称

' 2.p_sSQL ：读取数据的SQl语句

' 3.p_oDbConn ：数据库连接对象

'*****************************************************

Private Function GetDataXML(ByRef p_sTableName, ByRef p_sSQL, ByRef p_oDbConn)

Dim oRecordset

Dim sXMLStr, sCleanXML

Dim nEnsData

ON ERROR RESUME NEXT

nEnsData = 0

Set oRecordset = p_oDbConn.Execute(p_sSQL)

If Err.Number <>0 Then

m_nErrCode = m_nErrCode_ReadData

Exit Function

End If

IF (Not oRecordset.eof) Then

nEnsData = 1

End IF

IF (nEnsData = 1) Then

oRecordset.save m_oXMLDOM, 1

oRecordset.close

Set oRecordset = Nothing

sCleanXML = m_oXMLDOM.transformNode(m_oXSLDOM)

sXMLStr = "<" & p_sTableName & ">"

sXMLStr = sXMLStr & sCleanXML

sXMLStr = sXMLStr & "</" & p_sTableName & ">"

Else

sXMLStr = "<" & p_sTableName & "/>"

End IF

GetDataXML = sXMLStr

End Function

'*****************************************************

' 过程： SaveDataXML(ByRef p_sXMLStr)

' 描述：保存XML格式的字符串到文件

' 参数：

' p_sXMLStr ： XML格式的字符串

'*****************************************************

Private Sub SaveDataXML(ByRef p_sXMLStr)

Dim sFileInfo

If (Len(m_sSaveFileName) = 0) Then

m_sSaveFileName = GetRndFileName()

End If

If (Len(m_sSaveFilePath) = 0) Then

sFileInfo = m_sSaveFileName

Else

IF (Right(m_sSaveFilePath,1) = "/")Then

sFileInfo = m_sSaveFilePath & m_sSaveFileName

Else

sFileInfo = m_sSaveFilePath & "/" & m_sSaveFileName

End IF

End If

m_oXMLDOM.loadxml(p_sXMLStr)

ON ERROR RESUME NEXT

m_oXMLDOM.save ( Server.MapPath(sFileInfo) )

If Err.Number <>0 Then

m_nErrCode = m_nErrCode_Save

Exit Sub

End If

End Sub

'*****************************************************

' 过程： ResponseXML(ByRef p_sXMLStr)

' 描述：输出XML格式的字符串到浏览器

' 参数：

' p_sXMLStr ： XML格式的字符串

'*****************************************************

Private Sub ResponseXML(ByRef p_sXMLStr)

Response.CharSet = m_sEncoding

Response.ContentType = "text/xml"

Response.write p_sXMLStr

End Sub

'============================= 数据导出 End =============================

'============================= 数据导入 Begin =============================

'*****************************************************

' 过程： Import(ByRef p_oDbConn)

' 描述：导入数据

' 参数：

' p_oDbConn：数据库连接对象

'*****************************************************

Public Sub Import(ByRef p_oDbConn)

Dim oRootNode

If (Len(m_sXMLFile) < 1) Then

m_nErrCode = m_nErrCode_EnsFile

Exit Sub

End If

ON ERROR RESUME NEXT

Set m_oXMLDOM = Server.CreateObject("Microsoft.XMLDOM")

If Err.Number <>0 Then

m_nErrCode = m_nErrCode_XMLDOM

Exit Sub

End If

m_oXMLDOM.async = false

m_oXMLDOM.load( Server.MapPath(m_sXMLFile) )

If Err.Number <>0 Then

m_nErrCode = m_nErrCode_EnsFile

Exit Sub

End If

If (Len(m_oXMLDOM.xml) < 1) Then

m_nErrCode = m_nErrCode_ErrFile

Exit Sub

End If

Set oRootNode = m_oXMLDOM.documentElement

Set m_oXMLDOM = Nothing

m_sImportSQL = GetImportSQL(oRootNode)

Set oRootNode = Nothing

Call p_oDbConn.Execute(m_sImportSQL)

If Err.Number <>0 Then

m_nErrCode = m_nErrCode_WriteData

Exit Sub

End If

End Sub

'*****************************************************

' 函数： GetImportSQL(ByRef p_oDataBase)

' 描述：获得将XML数据转换为SQL后的字符串

' 参数：

' p_oDataBase ： XML文件的根节点

'*****************************************************

Private Function GetImportSQL(ByRef p_oDataBase)

Dim oTable, oRow, oDatas, oData

Dim sColNames, sColValues

Dim sColName

Dim sSQL, sTransactionSQL

sSQL = ""

For Each oTable In p_oDataBase.childNodes

For Each oRow In oTable.childNodes

Set oDatas = oRow.selectNodes("@*")

sColNames = ""

sColValues = ""

For Each oData In oDatas

sColName = oData.nodeName

If ( Instr( Lcase(Cstr(m_sVacancyCols)), Lcase(Cstr("," & sColName & ",")) ) < 1) Then

sColNames = sColNames & sColName & ", "

sColValues = sColValues & "'" & oData.nodeValue & "', "

End If

sColNames = "(" & Left(sColNames,Len(sColNames)-2) & ") "

sColValues = "(" & Left(sColValues,Len(sColValues)-2) & ") "

sSQL = sSQL & " Insert Into " & oTable.nodeName

sSQL = sSQL & " " & sColNames & " Values " & sColValues & " ; "

Set oData = Nothing

Set oDatas = Nothing

Set oRow = Nothing

Set oTable = Nothing

sTransactionSQL = "Set Xact_Abort On; "

sTransactionSQL = sTransactionSQL & " Begin Transaction; "

sTransactionSQL = sTransactionSQL & sSQL

sTransactionSQL = sTransactionSQL & " Commit Transaction; "

sTransactionSQL = sTransactionSQL & " Set Xact_Abort Off; "

GetImportSQL = sTransactionSQL

End Function

'============================= 数据导入 End =============================

'*****************************************************

' 函数： GetErrExegesis(ByRef p_nErrCode)

' 描述：获得错误代码的注释

' 参数：

' p_oDataBase ： XML文件的根节点

'*****************************************************

Public Function GetErrExegesis(ByRef p_nErrCode)

Dim sExegesis

Dim nErrCode

nErrCode = Cint(p_nErrCode)

Select Case (nErrCode)

Case m_nErrCode_NotErr

sXSLStr = "运行成功！"

Case m_nErrCode_NotArray

sXSLStr = "属性: SQL语句数组不正确！"

Case m_nErrCode_XMLDOM

sXSLStr = "不能创建XML文档，服务器必须支持MSXML！"

Case m_nErrCode_ReadData

sXSLStr = "读取数据库数据发生错误！ " & " "

sXSLStr = sXSLStr & " 请检查 " & " "

sXSLStr = sXSLStr & "1.数据库是否已连接 " & " "

sXSLStr = sXSLStr & "2.语句是否正确 "

Case m_nErrCode_WriteData

sXSLStr = "写入数据库数据发生错误！ " & " "

sXSLStr = sXSLStr & " 请检查 " & " "

sXSLStr = sXSLStr & "1.数据库是否已连接 " & " "

sXSLStr = sXSLStr & "2.SQL语句是否正确 " & " "

sXSLStr = sXSLStr & "SQL语句 " & " "

sXSLStr = sXSLStr & "" & m_sImportSQL

Case m_nErrCode_Save

sXSLStr = "不能保存XML文档，请检查是否对该目录或文件有' 写入权限 ' ！"

Case m_nErrCode_EnsFile

sXSLStr = "不能读取XM数据，XML文件不存在 ' ！"

sXSLStr = sXSLStr & "文件：" & m_sXMLFile

Case m_nErrCode_ErrFile

sXSLStr = "不能读取XM数据，XML文件格式错误 ' ！"

sXSLStr = sXSLStr & "文件：" & m_sXMLFile

Case Else

sXSLStr = "未知错误！"

End Select

GetErrExegesis = " " & sXSLStr & " "

End Function

End Class