WEB开发网
开发学院WEB开发ASP 如何用Asp动态生成xml文件 阅读

如何用Asp动态生成xml文件

 2003-02-18 11:08:52 来源:WEB开发网   
核心提示:Function ReplaceChar ( FstrSource ) dim strRet if IsNull(FstrSource) then FstrSource = "" end if strRet = Replace ( FstrSource , "&" ,

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

Tags:如何 Asp 动态

编辑录入:爽爽 [复制链接] [打 印]
赞助商链接