ADO資料與XML資料間的轉換的類(ASP實現) (轉)[@more@]

當對現有的資料進行分析時，經常需要對某一部分的資料進行分析.此時，使用
1.查詢分析器？
但其往往不直觀，查詢某個關鍵字又需要重新新的SQL.
2.SQL模板？
但又不一定有建立新的虛擬目錄，且某些SQL語句SQLXML模板不支援

資料拆離時也有相似問題。
尤其當不同，不同環境，需要重新匯入資料，進行分析或拆離，困難尤為明顯。
能不能有一種方法，可以將資料脫離於資料庫進行分析，需要時再匯入到資料庫中？
XML是個很好的選擇！
ADO本身支援資料到XML的轉換，只需要對其格式進行解析，成為自己的XML通用格式，就可以進行本地分析
而對通用XML格式進行資料庫對映，就可完成資料重新匯入資料庫的工作.

下面是一個ADO資料(表的基本資料)與XML資料間的相互轉換的類(實現)，初步完成表資料的匯入、匯出。
通用表間關係對映(透過XSD描述),考慮之中，希望各位賜教指點，不勝感激.

一個類的例子：
example.asp

<!--#include file="tranormData.asp"--&gt
Dim aSQL(1,1)
Dim oXMLData

'====== 連線資料庫過程 ======
'獲得資料庫連線 oConn
'====== 連線資料庫過程 ======

aSQL(0,0) = "PubLable"
aSQL(0,1) = " * 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)
' 創建人 : moonpiazza
' 日期 : 2003.5.21
' 描述 : ADO資料與XML資料間的轉換(ASP實現)
' 版本 : 1.0
' 功能 : ADO資料(表的基本資料)與XML資料間的相互轉換
' 待改進 : 表間資料的關聯性(通用)，資料量大時速度問題
'
' 版權 : 歡迎改進，翻版不究 :_)
'
'*****************************************************

'*****************************************************
' 公共方法： Export, Import, GetErrExegesis
'*****************************************************

'============================= 公共變數 End =============================
Private m_oXML
Private m_oDOM
'============================= 公共變數 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_Tenate()
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.Create(".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 = ""
sDataXML = sDataXML & ""

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 & ""

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 & ""
sXSLStr = sXSLStr & ""
sXSLStr = sXSLStr & ""
sXSLStr = sXSLStr & ""
sXSLStr = sXSLStr & ""

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 = ""
sXMLStr = sXMLStr & sCleanXML
sXMLStr = sXMLStr & "" & p_sTableName & ">"
Else
sXMLStr = ""
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 oNode

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 lNames, 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 & " ; "

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

ADO資料與XML資料間的轉換的類(ASP實現) (轉)

相關文章