asp动态生成google的sitemap地图的代码
本来使用那些网站生成google网站地图,时间久了,感觉太麻烦了:先打开他们的网站,输入我的网址,然后点击生成,等待一段时间后,下载生成后的文件,再将它通过ftp上传到空间上了。实在太麻烦了,还不如自己用asp去写一个。 把下面代码保存为sitemap.asp文件
<!--#include file="conn.asp"--> <% session("count")=0 strURL = "http://" & request.servervariables("SERVER_NAME") & _ left(request.servervariables("SCRIPT_NAME"),len(request.servervariables("SCRIPT_NAME"))-len("/sitemap.asp")) dim foolcat foolcat = foolcat + "<?xml version=""1.0"" encoding=""UTF-8""?>" foolcat = foolcat + "<!--Google Site Map File Generated by http://www.xxx.com " & return_RFC822_Date(now,"GMT") & "-->" foolcat = foolcat + "<urlset xmlns=""http://www.google.com/schemas/sitemap/0.84"">" foolcat = foolcat + "<url>" foolcat = foolcat + "<loc>" & strURL & "/</loc> " foolcat = foolcat + "</url>" session("count")=session("count")+"1" set all_fs = Server.CreateObject("Scripting.FileSystemObject") set all_folder = all_fs.GetFolder(server.MapPath("/")) set all_files = all_folder.files for each file in all_files foolcat = foolcat + "<url>" foolcat = foolcat + "<loc>" & strURL & "/" & File.Name & "</loc> " foolcat = foolcat + "</url>" session("count")=session("count")+"1" next dim js,sql set js = server.CreateObject("ADODB.RecordSet") sql = "select * from [要生成的表名] order by sid asc" //修改你要生成的数据表名 set js = conn.execute (sql) do until js.eof id=""&js("id")&"" //修改为你的id字段 foolcat = foolcat + "<url>" foolcat = foolcat + "<loc>" & strURL & "/xxx.asp?Id=" & id & "</loc> " //修改为你的文件名称和id foolcat = foolcat + "</url>" session("count")=session("count")+"1" js.movenext loop js.close set js = nothing foolcat = foolcat + "</urlset>" foolcat = "" + foolcat + "" foolcat = "" & foolcat & "" FolderPath = Server.MapPath("/") Set fso = Server.CreateObject("Scripting.FileSystemObject") Set fout = fso.CreateTextFile(FolderPath&"\sitemap.xml") fout.writeLine foolcat fout.close set fout = nothing conn.close set conn = nothing Function return_RFC822_Date(byVal myDate, byVal TimeZone) Dim myDay, myDays, myMonth, myYear Dim myHours, myMinutes, mySeconds myDate = CDate(myDate) myDay = EnWeekDayName(myDate) myDays = Right("00" & Day(myDate),2) myMonth = EnMonthName(myDate) myYear = Year(myDate) myHours = Right("00" & Hour(myDate),2) myMinutes = Right("00" & Minute(myDate),2) mySeconds = Right("00" & Second(myDate),2) return_RFC822_Date = myDay&", "& _ myDays&" "& _ myMonth&" "& _ myYear&" "& _ myHours&":"& _ myMinutes&":"& _ mySeconds&" "& _ " " & TimeZone End Function Function EnWeekDayName(InputDate) Dim Result Select Case WeekDay(InputDate,1) Case 1:Result="Sun" Case 2:Result="Mon" Case 3:Result="Tue" Case 4:Result="Wed" Case 5:Result="Thu" Case 6:Result="Fri" Case 7:Result="Sat" End Select EnWeekDayName = Result End Function Function EnMonthName(InputDate) Dim Result Select Case Month(InputDate) Case 1:Result="Jan" Case 2:Result="Feb" Case 3:Result="Mar" Case 4:Result="Apr" Case 5:Result="May" Case 6:Result="Jun" Case 7:Result="Jul" Case 8:Result="Aug" Case 9:Result="Sep" Case 10:Result="Oct" Case 11:Result="Nov" Case 12:Result="Dec" End Select EnMonthName = Result End Function %>
sitemap.xml生成完毕,共生成<%=session("count")%>个文件,点击查看<a href="sitemap.xml">sitemap.xml</a>文件。