<!--#include file="conn.asp"-->
<!--#include file="inc/const.asp"-->
<%
Server.ScriptTimeout = 50000
Dim Rs,SQL,XMLContent,Thisurl
Dim CreateHtml,ChannelRootDir,ChannelID
Dim XMLDOM,node,Cnode,Cnode1,msginfo
Thisurl="http://" & Request.ServerVariables("HTTP_HOST")
'Response.Clear
'Response.CharSet="UTF-8"
'Response.ContentType="text/xml"
Call IndexSiteMap("/")
'Call ChannelSiteMap("./")
'Response.Write XMLContent
'Response.Write Newasp.FormatDate(now,2)
Sub IndexSiteMap(strPath)
	XMLContent = "<?xml version='1.0' encoding='UTF-8'?>" & vbNewLine
	XMLContent = XMLContent & "<urlset xmlns=""http://www.google.com/schemas/sitemap/0.84"">" & vbNewLine
	XMLContent = XMLContent & "<url>" & vbNewLine
	XMLContent = XMLContent & "<loc>" & Thisurl & "/</loc>" & vbNewLine & "<lastmod>" & Newasp.FormatDate(Now(),2) & "</lastmod>" & vbNewLine & "<changefreq>daily</changefreq>" & vbNewLine & "<priority>1.0</priority>" & vbNewLine
	XMLContent = XMLContent & "</url>" & vbNewLine
	LoadSitemap 2,0
	LoadSitemap 1,0
	XMLContent = XMLContent & "</urlset>"
	strPath = Server.MapPath(strPath) & "\sitemap.xml"
	CreateXMLFile XMLContent,strPath
	Response.Write "生成站点地图成功！"
End Sub 
Sub ChannelSiteMap(strPath)
	XMLContent = "<?xml version='1.0' encoding='UTF-8'?>" & vbNewLine
	XMLContent = XMLContent & "<urlset xmlns=""http://www.google.com/schemas/sitemap/0.84"">" & vbNewLine
	XMLContent = XMLContent & "<url>" & vbNewLine
	XMLContent = XMLContent & "<loc>" & Thisurl & "/code/</loc>" & vbNewLine & "<lastmod>" & Now() & "</lastmod>" & vbNewLine & "<changefreq>daily</changefreq>" & vbNewLine & "<priority>1.0</priority>" & vbNewLine
	XMLContent = XMLContent & "</url>" & vbNewLine
	LoadSitemap 2,11
	XMLContent = XMLContent & "</urlset>"
	strPath = Server.MapPath(strPath) & "\sitemap.xml"
	CreateXMLFile XMLContent,strPath
	Response.Write "生成站点地图成功！"
End Sub 
Function LoadSitemap(ByVal sid, ByVal chanid)
	chanid = Newasp.ChkNumeric(chanid)
	Dim FindOrder,TableName
	If sid = 1 Then
		TableName = "[xp90com_Article]"
		FindOrder = "ORDER BY A.WriteTime DESC,A.ArticleID DESC"
		SQL = " A.ArticleID,A.ClassID,A.ChannelID,A.WriteTime,A.HtmlFileDate,"
	Else
		TableName = "[xp90com_SoftLists]"
		FindOrder = "ORDER BY A.SoftTime DESC ,A.SoftID DESC"
		SQL = " A.SoftID,A.ClassID,A.ChannelID,A.SoftTime,A.HtmlFileDate,"
	End If
	If chanid = 0 Then
		SQL = "SELECT TOP 3000 " & SQL & " C.HtmlFileDir,B.ChannelDir,B.IsCreateHtml,B.HtmlExtName,B.HtmlPath,B.HtmlForm,B.HtmlPrefix FROM (" & TableName & " A INNER JOIN [xp90com_Classify] C On A.ClassID=C.ClassID) INNER JOIN [xp90com_Channel] B On A.ChannelID=B.ChannelID WHERE A.isAccept>0 " & FindOrder
	Else
		SQL = "SELECT " & SQL & " C.HtmlFileDir,B.ChannelDir,B.IsCreateHtml,B.HtmlExtName,B.HtmlPath,B.HtmlForm,B.HtmlPrefix FROM (" & TableName & " A INNER JOIN [xp90com_Classify] C On A.ClassID=C.ClassID) INNER JOIN [xp90com_Channel] B On A.ChannelID=B.ChannelID WHERE A.ChannelID=" & chanid & " And A.isAccept>0 " & FindOrder
	End If
	Set Rs = Newasp.Execute(SQL)
	If Rs.BOF And Rs.EOF Then
	Else
		CreateHtml = 1'Rs("IsCreateHtml")
		Do While Not Rs.EOF
			Call LoadSoftList()
			Rs.MoveNext
		Loop
	End If
	Rs.Close: Set Rs = Nothing
End Function
Sub LoadSoftList()
	Dim HtmlFileName,LinksUrl,strLinksUrl
	ChannelID = Rs(2)
	Newasp.LoadChannel(ChannelID)
	ChannelRootDir = Newasp.ChannelPath
	If CInt(CreateHtml) <> 0 Then
		HtmlFileName = Newasp.ReadFileName(Rs("HtmlFileDate"), Rs(0), Newasp.ChannelHtmlExt, Newasp.ChannelPrefix, Newasp.ChannelHtmlForm, "")
		LinksUrl = ShowChannelPath(Newasp.ChannelPath, Rs("HtmlFileDir")) & Newasp.ShowDatePath(Rs("HtmlFileDate"), Newasp.ChannelHtmlPath) & HtmlFileName
	Else
		LinksUrl = ChannelRootDir & "show.asp?id=" & Rs(0)
	End If
	strLinksUrl = "<url>" & vbNewLine
	strLinksUrl = strLinksUrl & "<loc>" & Thisurl & LinksUrl & "</loc>" & vbNewLine & "<lastmod>" & Newasp.FormatDate(Rs(3),2) & "</lastmod>" & vbNewLine & "<changefreq>daily</changefreq>" & vbNewLine & "<priority>1.0</priority>" & vbNewLine
	strLinksUrl = strLinksUrl & "</url>" & vbNewLine
	XMLContent = XMLContent & strLinksUrl
End Sub
'================================================
'函数名：CreateXMLFile
'作  用：创建XML文件
'参  数：XmlStr   ----XML字符串
'        FormPath    ----创建的文件路径
'================================================
Function CreateXMLFile(sXML,FilePath)
	Dim objXML
	If InStr(FilePath, ":") = 0 Then FilePath = Server.MapPath(FilePath)
	Set objXML = Server.CreateObject("MSXML2.DOMDocument.3.0") 
	If objXML.LoadXml(sXML) Then
		objXML.Save(FilePath)
	End If
	Set objXML = Nothing
End Function 
%>

' 技术支持：QQ:8013282 邮箱:xp90com_@163.com  电话:15992457436
' 论坛支持：华锁论坛(blog.xp90.com)
' 官方网站：华锁源码(www.xp90.com www.xp90.cn www.xp90.com.cn www.xp90.org www.xp90.net xp90.org.cn xp90.net.cn)
'=====================================================================
