Design and use Class 6 in ASP

Class transformdata

'*************************************** **************
'Copyright (c) 2003
'Creator: moonpiazza
'Day: 2003.5.21
'Description: conversion between ADO data and XML data (implemented by ASP)
'Version: 1.0
'Power: the conversion between ADO data (basic table data) and XML data
'To be modified: the Association of data between tables (common), high speed of data volume
'
'Version right: Welcome to improve the version. skip this step :_)
'
'*************************************** **************

'*************************************** **************
'Public Methods: Export, Import, geterrexegesis
'*************************************** **************

'============================ Public variable end ======== ======================================
Private m_oxmldom
Private m_oxsldom
'========================== Public variable begin ======== ======================================

'============================ Error Code definition 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 of the Error Code definition ======================================

'============================ Attribute definition 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

'*************************************** **************
'Attribute: asqldata
'Status: writable
'Type: 2-dimensional array
'Description: SQL statement array. The Dimension 1 indicates the table name and the dimension 2 indicates the corresponding SQL statement.
'*************************************** **************
Public property let asqldata (byref p_asqldata)
M_asqldata = p_asqldata
End Property

'*************************************** **************
'Property: bissave
'Status: writable
'Type: Number (0, 1) default (1)
'Description: whether to save the exported data as an XML file.
'*************************************** **************
Public property let bissave (byref p_bissave)
M_bissave = CINT (p_bissave)
End Property

'*************************************** **************
'Property: bisoutput
'Status: writable
'Type: Number (0, 1) default (0)
'Description: whether to display XML data when exporting data.
'*************************************** **************
Public property let bisoutput (byref p_bisoutput)
M_bisoutput = CINT (p_bisoutput)
End Property

'*************************************** **************
'Property: ssavefilename
'Status: writable and readable
'Type: String default (getrndfilename ())
'Description: the XML file name if XML data is saved during data export.
'*************************************** **************
Public property let ssavefilename (byref p_ssavefilename)
M_ssavefilename = p_ssavefilename
End Property

Public property get ssavefilename ()
Ssavefilename = m_ssavefilename
End Property

'*************************************** **************
'Property: ssavefilepath
'Status: writable and readable
'Type: String default ("")
'Description: If the XML data is saved during data export, the path of the XML file (relative path)
'*************************************** **************
Public property let ssavefilepath (byref p_ssavefilepath)
M_ssavefilepath = p_ssavefilepath
End Property

Public property get ssavefilepath ()
Ssavefilepath = m_ssavefilepath
End Property

'*************************************** **************
'Property: sxmlfile
'Status: writable
'Type: String
'Description: XML file (including relative path) of the data source when importing data)
'*************************************** **************
Public property let sxmlfile (byref p_sxmlfile)
M_sxmlfile = p_sxmlfile
End Property

'*************************************** **************
'Attribute: svacancycols
'Status: writable
'Type: String default ("")
'Format "NID, ddate" (separated)
'Description: When importing data, you can specify the value of some fields without importing (shielding fields)
'*************************************** **************
Public property let svacancycols (byref p_svacancycols)
M_svacancycols = "," & p_svacancycols &","
End Property

'*************************************** **************
'Property: nerrcode
'Status: readable
'Type: Number default (0)
'Description: error code. You can use the geterrexegesis (byref p_nerrcode) method to obtain comments.
'*************************************** **************
Public property get nerrcode ()
Nerrcode = m_nerrcode
End Property

'*************************************** **************
'Property: sencoding
'Status: writable
'Type: String default ("gb2312 ")
'Description: encoding type of the XML file.
'*************************************** **************
Public property let sencoding (byref p_sencoding)
M_sencoding = p_sencoding
End Property

'*************************************** **************
'Property: simportsql
'Status: readable
'Type: String default ("gb2312 ")
'Description: the SQL statement generated when data is imported.
'*************************************** **************
Public property get simportsql ()
Simportsql = m_simportsql SQL
End Property
'============================ Attribute definition end ======== ======================================

'*************************************** **************
'Initialization class
'*************************************** **************
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

'*************************************** **************
'Logout class
'*************************************** **************
Private sub class_terminate ()
Set m_oxmldom = nothing
Set m_oxsldom = nothing
End sub

'============================ Export data begin ======== ======================================

'*************************************** **************
'Process: Export (byref p_odbconn)
Description: data export.
'Parameter:
'P_odbconn: database connection object
'
'*************************************** **************
Public sub Export (byref p_odbconn)
Dim Ni, nmaxi
Dim stablename, ssql
Dim sdataxml, s0000str
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

S0000str = getxsl ()

M_oxmldom.async = false
M_oxsldom.async = false
M_oxsldom.loadxml (s‑str)

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

'*************************************** **************
'Function: getrndfilename ()
'Description: gets a random name, which consists of the current time and 7 random numbers.
'*************************************** **************
Private function getrndfilename ()
Dim Nmax, Nmin
Dim srnd, sdate

Randomize

Nmin= 1000000
Nmax= 9999999

Srnd = int (Nmax-Nmin + 1) * RND) + Nmin)
Sdate = Replace (replace (now (),"-",""),":",""),"","")

Getrndfilename = "_" & sdate & srnd & ". xml"

End Function

'*************************************** **************
'Function: getxsl ()
'Description: gets the XSL file string.
'*************************************** **************
Private function getxsl ()
Dim s0000str

S0000str = ""
S0000str = s0000str & "<? XML version = '1. 0' encoding = '"& m_sencoding &"'?> "
S‑str = s‑str & "<XSL: stylesheet version = '1. 0 'xmlns: XSL = 'HTTP: // www.w3.org/5o/#/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 = '# rowsetscheme'>"
S0000str = s0000str & "<XSL: Output omit-XML-declaration = 'yes'/>"
S0000str = s0000str & "<XSL: template match = '/'>"
S0000str = s0000str & "<XSL: For-each select = '/XML/RS: Data/Z: row'>"
S0000str = s0000str & "<XSL: element name = 'row'>"
S0000str = s0000str & "<XSL: For-each select = '@ *'>"
S0000str = s0000str & "<XSL: attribute name = '{name ()}'>"
S0000str = s0000str & "<XSL: value-of select = '.'/>"
S0000str = s0000str & "</XSL: attribute>"
S0000str = s0000str & "</XSL: For-each>"
S0000str = s0000str & "</XSL: Element>"
S0000str = s0000str & "</XSL: For-each>"
S0000str = s0000str & "</XSL: Template>"
S‑str = s‑str & "</XSL: stylesheet>"

Getxsl = s0000str

End Function

'*************************************** **************
'Function: getdataxml (byref p_stablename, byref p_ssql, byref p_odbconn)
'Description: executes a single SQL statement to obtain the XML after data conversion.
'Parameter:
'1. p_stablename: Table Name
'2. p_ssql: SQL statement for reading data
'3. p_odbconn: database connection object
'
'*************************************** **************
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

'*************************************** **************
'Process: savedataxml (byref p_sxmlstr)
'Description: Save the string in XML format to the file.
'Parameter:
'P_sxmlstr: String in XML format
'*************************************** **************
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

'*************************************** **************
'Process: responsexml (byref p_sxmlstr)
'Description: outputs a string in XML format to the browser.
'Parameter:
'P_sxmlstr: String in XML format
'*************************************** **************
Private sub responsexml (byref p_sxmlstr)
Response. charset = m_sencoding
Response. contenttype = "text/XML"
Response. Write p_sxmlstr
End sub

'============================== Data export end ======== ======================================

'============================ Data import begin ======== ======================================

'*************************************** **************
'Process: Import (byref p_odbconn)
Description: import data.
'Parameter:
'P_odbconn: database connection object
'
'*************************************** **************
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 = getimpsql SQL (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

'*************************************** **************
'Function: getimportsql (byref p_odatabase)
'Description: gets the string after converting XML data to SQL.
'Parameter:
'P_odatabase: Root Node of the XML file
'
'*************************************** **************
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

'============================== Import data to end ======== ======================================

'*************************************** **************
'Function: geterrexegesis (byref p_nerrcode)
'Description: gets the comment of the error code.
'Parameter:
'P_odatabase: Root Node of the XML file
'
'*************************************** **************
Public Function geterrexegesis (byref p_nerrcode)
Dim sexegesis
Dim nerrcode

Nerrcode = CINT (p_nerrcode)

Select case (nerrcode)

Case m_nerrcode_noterr
S0000str = "running successful! "

Case m_nerrcode_notarray
S0000str = "attribute: the SQL statement array is incorrect! "

Case m_nerrcode_xmldom
S0000str = "you cannot create XML documents. The server must support MSXML! "

Case m_nerrcode_readdata
S0000str = "An error occurred while reading database data! "&" <Br>"
S0000str = s0000str & "check "&""
S0000str = s0000str & "1. Whether the database is connected "&""
S0000str = s0000str & "2. whether the statement is correct"

Case m_nerrcode_writedata
S0000str = "An error occurred while writing data to the database! "&" <Br>"
S0000str = s0000str & "check "&""
S0000str = s0000str & "1. Whether the database is connected "&""
S0000str = s0000str & "2. Check whether the SQL statement is correct" & "<br>"
S0000str = s0000str & "SQL statement" & "<br>"
Sshortstr = sshortstr & "& m_simportsql

Case m_nerrcode_save
S0000str = "the XML document cannot be saved. Check whether the directory or file has 'write authorization '! "

Case m_nerrcode_ensfile
S0000str = "XM data cannot be read. xml file does not exist '! "
S0000str = s0000str & "file:" & m_sxmlfile

Case m_nerrcode_errfile
S0000str = "XM data cannot be read. xml file format is incorrect '! "
S0000str = s0000str & "file:" & m_sxmlfile

Case else
S0000str = "Unknown error! "

End select

Geterrexegesis = "<br>" & s0000str & "<br>"

End Function

End Class