您现在的位置: 军旅同心-旅游自驾-军旅文学 >> 读书赏析 >> 学习园地 >> 电脑网络 >> 技术文章 >> 正文
ADO数据与XML数据间的转换的类
作者:采集员 文章来源:来源于网络 点击数: 更新时间:2005-9-10 12:32:10
l 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_

上一页  [1] [2] [3] 下一页


更多
免责声明:作品版权归所属媒体与作者所有!!本站刊载此文不代表同意其说法或描述,仅为提供更多信息。如果您认为我们侵犯了您的版权,请告知!本站立即删除。有异议请联系我们。
文章录入:烟灰缸    责任编辑:烟灰缸 
网友评论:(只显示最新10条。评论内容只代表网友观点,与本站立场无关!)
| 设为首页 | 加入收藏 | 联系站长 | 友情链接 | 网站地图 | 版权申明 | 网站公告 | 管理登录 |