ASP中设计和使用类6

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, 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

    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

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 = "读取数据库数据发生错误！ " & "<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