| ncoding = "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
& 上一页 [1] [2] [3] 下一页 | 
