ADO数据与XML数据间的转换的类
类别: ASP教程
当对现有数据库的数据进行分析时,经常需要对某一部分的数据进行分析.此时,使用
1.SQL查询分析器?
但其往往不直观,查找某个关键字又需要重新执行新的SQL.
2.SQLXML模板?
但又不一定有权限建立新的虚拟目录,且某些SQL语句SQLXML模板不支持
数据拆离时也有相似问题。
尤其当不同网络,不同环境,需要重新导入数据,进行分析或拆离,困难尤为明显。
能不能有一种方法,可以将数据脱离于数据库进行分析,需要时再导入到数据库中?
XML是个很好的选择!
ADO本身支持数据到XML的转换,只需要对其格式进行解析,成为自己的XML文件通用格式,就可以进行本地分析
而对通用XML格式进行数据库映射,就可完成数据重新导入数据库的工作.
下面是一个ADO数据(表的基本数据)与XML数据间的相互转换的类(ASP实现),初步完成表数据的导入、导出。
通用表间关系映射(通过XSD描述),考虑之中,希望各位赐教指点,不胜感激.
一个调用类的例子:
example.asp
<!--#include file="transformXML.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
\'*****************************************************
\' Copyright (c) 2003
\' 创 建 人 : 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
Next
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
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
Next
sColNames = "(" & Left(sColNames,Len(sColNames)-2) & ") "
sColValues = "(" & Left(sColValues,Len(sColValues)-2) & ") "
sSQL = sSQL & " Insert Into " & oTable.nodeName
sSQL = sSQL & " " & sColNames & " Values " & sColValues & " ; "
Next
Next
Set oData = Nothing
Set oDatas = Nothing
Set oRow = Nothing
Set oTable = Nothing
GetImportSQL = sSQL
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 = "读取数据库数据发生错误! " & "<BR>"
sXSLStr = sXSLStr & " 请检查 " & " "
sXSLStr = sXSLStr & "1.数据库是否已连接 " & " "
sXSLStr = sXSLStr & "2.语句是否正确 "
Case m_nErrCode_WriteData
sXSLStr = "写入数据库数据发生错误! " & "<BR>"
sXSLStr = sXSLStr & " 请检查 " & " "
sXSLStr = sXSLStr & "1.数据库是否已连接 " & " "
sXSLStr = sXSLStr & "2.SQL语句是否正确 " & "<BR>"
sXSLStr = sXSLStr & "SQL语句 " & "<BR><BR>"
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 = "<BR>" & sXSLStr & "<BR>"
End Function
End Class
%>
1.SQL查询分析器?
但其往往不直观,查找某个关键字又需要重新执行新的SQL.
2.SQLXML模板?
但又不一定有权限建立新的虚拟目录,且某些SQL语句SQLXML模板不支持
数据拆离时也有相似问题。
尤其当不同网络,不同环境,需要重新导入数据,进行分析或拆离,困难尤为明显。
能不能有一种方法,可以将数据脱离于数据库进行分析,需要时再导入到数据库中?
XML是个很好的选择!
ADO本身支持数据到XML的转换,只需要对其格式进行解析,成为自己的XML文件通用格式,就可以进行本地分析
而对通用XML格式进行数据库映射,就可完成数据重新导入数据库的工作.
下面是一个ADO数据(表的基本数据)与XML数据间的相互转换的类(ASP实现),初步完成表数据的导入、导出。
通用表间关系映射(通过XSD描述),考虑之中,希望各位赐教指点,不胜感激.
一个调用类的例子:
example.asp
<!--#include file="transformXML.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
\'*****************************************************
\' Copyright (c) 2003
\' 创 建 人 : 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
Next
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
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
Next
sColNames = "(" & Left(sColNames,Len(sColNames)-2) & ") "
sColValues = "(" & Left(sColValues,Len(sColValues)-2) & ") "
sSQL = sSQL & " Insert Into " & oTable.nodeName
sSQL = sSQL & " " & sColNames & " Values " & sColValues & " ; "
Next
Next
Set oData = Nothing
Set oDatas = Nothing
Set oRow = Nothing
Set oTable = Nothing
GetImportSQL = sSQL
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 = "读取数据库数据发生错误! " & "<BR>"
sXSLStr = sXSLStr & " 请检查 " & " "
sXSLStr = sXSLStr & "1.数据库是否已连接 " & " "
sXSLStr = sXSLStr & "2.语句是否正确 "
Case m_nErrCode_WriteData
sXSLStr = "写入数据库数据发生错误! " & "<BR>"
sXSLStr = sXSLStr & " 请检查 " & " "
sXSLStr = sXSLStr & "1.数据库是否已连接 " & " "
sXSLStr = sXSLStr & "2.SQL语句是否正确 " & "<BR>"
sXSLStr = sXSLStr & "SQL语句 " & "<BR><BR>"
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 = "<BR>" & sXSLStr & "<BR>"
End Function
End Class
%>
- 上一篇: ASP开发网页时需要牢记的注意事项列表
- 下一篇: 将RECORDSET作为XML保存
-= 资 源 教 程 =-
文 章 搜 索