为google量身定做的sitemap生成代码asp版


            外面很多所谓sitemap生成代码都只生成目录文件地址,没生成动态的,我后来自己写了这个,是支持动态的,例子: 如你是文章网站,文章有2000条,那你修改下对应你的文章数据表,即可生成除了所有目录文件外,还生成你的动态2000条地址,绝对的没话说,生成速度非常快 把下面代码保存为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 id 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 %>