Function ReplaceChar ( FstrSource )
dim strRet
if IsNull(FstrSource) then
FstrSource = ""
end if
strRet = Replace ( FstrSource , "&" , "&" )
strRet = Replace ( strRet , "<" , "<" )
strRet = Replace ( strRet , ">" , ">" )
strRet = Replace ( strRet , """" , """ )
strRet = Replace ( strRet , "'" , "'" )
ReplaceChar = strRet
End Function
function RstToXML (FrstRst, FstrRstName)
dim strSpace 'space string behand of element
dim intLevel 'level of the element
dim strXML 'the return string(xml string)
dim intRstField
dim strShortDate
'document level
intLevel = 0
strSpace = space (intLevel * 2)
if Len(FstrRstName)>0 then
strXML=strSpace & "<" & FstrRstName & ">" & vbCR
intLevel = intLevel + 1
strSpace = space(intLevel*2)
end if
if FrstRst.EOF then
strXML = strXML&strSpace & "<Record"
for nCount=0 to FrstRst.Fields.Count-1
strXML = strXML & space(1)&FrstRst.Fields(nCount).Name&"=''"
next
strXML = strXML & "/>" &vbCR
if Len(FstrRstName)>0 then
strXML=strXML&strSpace & "</" & FstrRstName & ">" & vbCR
end if
RstToXML=strXML
exit function
end if
' now move in one level
intLevel = intLevel + 1
strSpace = space (intLevel * 2)
' loop through the records
dim strTemp
FrstRst.MoveFirst
do while not FrstRst.EOF
strTemp = ""
'loop through the fields
'strXML = strXML & strSpace & "<Record"
for each objField in FrstRst.Fields
'set objField = FrstRst.Fields(intRstField)
strTemp = strTemp & space (1) & objField.Name & "="
strTemp = strTemp & """" & ReplaceChar(objField.Value) & """"
end if
next
strXML = strXML & "<Record "&strTemp& "/>" & vbCR
FrstRst.MoveNext
loop
intLevel=intLevel-1
strSpace=space(intLevel * 2)
if Len(FstrRstName)>0 then
strXML = strXML & strSpace & "</" & FstrRstName & ">" & vbCR
end if
RstToXML = strXML
end function
getInfo.asp
========================================
<?xml version="1.0" encoding="gb2312"?>
<root>
<%
set conn = server.CreateObject("ADODB.Connection")
conn.Open "FILEDSN=test.dsn"
set facultyRst = conn.Execute("select * from faculty")
do while not facultyRst.eof
strFaculty = facultyRst("name")
set classRst = conn.Execute("select count(id) as classcount from recruitclass where recruityear=" + cstr(year(now)) + " and faculty='" + strFaculty + "'")
set maleRst = conn.Execute("select count(id) as malecount from newstudent where recruityear=" + cstr(year(now)) + " and faculty='" + strFaculty + "' and gender='男'")
set femaleRst = conn.Execute("select count(id) as femalecount from newstudent where recruityear=" + cstr(year(now)) + " and faculty='" + strFaculty + "' and gender='女'")
%>
<newstudent faculty="<%=strFaculty%>" class="<%=classRst("classcount")%>" male="<%=maleRst("malecount")%>" female="<%=femaleRst("femalecount")%>"/>
<%
facultyRst.MoveNext
loop
%>
</root>
<%
dim strConn, strSQL, rs, n, sFileName
'change the server name, if it is remote, change the UID and PWD to your own
strConn = "Provider=SQLOLEDB;Server=localhost;Database=pubs;UID=sa;PWD=;"
strSQL = "SELECT * FROM employee"
set rs = Server.CreateObject("ADODB.Recordset")
rs.open strSQL, strConn, 1, 1
sFileName = "c:\temp\employee.xml"
rs.save sFileName, 1
rs.close
set rs =nothing
%>
or
<%
Response.ContentType = "text/xml"
dim strConn, strSQL, rs, n, sFileName
'change the server name, if it is remote, change the UID and PWD to your own
strConn = "Provider=SQLOLEDB;Server=localhost;Database=pubs;UID=sa;PWD=;"
strSQL = "SELECT * FROM employee"
set rs = Server.CreateObject("ADODB.Recordset")
rs.open strSQL, strConn, 1, 1
sFileName = "c:\temp\employee.xml"
rs.save Response, 1
rs.close
set rs =nothing
%>
……