|
- 帖子
- 116
- 积分
- 69
- 贡献
- 3
- 鲜花
- 0
- 臭蛋
- 0
- 来自
- 辽宁
- 在线时间
- 328 小时
- 注册时间
- 2005-10-20
|
[代码发布] [落伍首发]马克斯MAXZ5.0生成GG SiteMap代码(贴代码)
在代码区的帖子不能编辑...昨天附件没有上传...
新人区不能用code代码....哎....发个代码费了牛劲了.....
斑竹把那两个删除了吧....这个帖子继续等待审核...哈哈哈......
用MAXZ5.0的人不少...都在搞SEO,做了一个后台生成sitemap的程序...
我自己还没有用的..就贡献出来了....
先在管理的admin_index.asp修改- menu(2,3)="<a target=main href=make.asp>生成选项</a>"
- menu(2,4)="<a target=main href=make_ggmap.asp>生成GG Sitemap</a>"
- <!--#include file="conn.asp"-->
- <!-- #include file="check.asp" -->
- <%
- '==================================
- ' Google SiteMap for MAXZ5.0
- ' 更新时间: 2008-2-22
- ' Eming & Xuesharp
- ' www.tuibian.com
- ' 注:num为提取电影的个数,设为0为全部
- '==================================
- Dim num,SiteURL
- num=100
- SiteURL="http://"&maxz_2&"/"
- 'Response.write SiteURL
- Sub Escape(ByRef s)
- s = Replace(s, "&", "&")
- s = Replace(s, "'", "'")
- s = Replace(s, """", """)
- s = Replace(s, "<", ">")
- s = Replace(s, ">", "<")
- End Sub
- '制作生成SiteMap.xml的目录,后面不要带"/",大小写敏感
- filename="../sitemap.xml"
- set objfso = CreateObject("Scripting.FileSystemObject")
- rootfile = Server.MapPath(filename)
- 'response.End
- '创建文件
- objfso.createtextfile(rootfile)
- response.write "<p><strong style='font-family:arial,sans-serif;font-size=12'>创建SiteMap.xml成功！</strong><I style='font-family:arial,sans-serif;font-size=12'> "&rootfile&" </I></p>"
- response.write "<p><strong style='font-family:arial,sans-serif;font-size=12'>对不起了兄弟们,懒得做提交页面,已经开始索引了,正在索引文件,请稍侯吧,如果电影数量较多,时间会稍微长一些,可以修改make_ggmap.asp文件中的num变量,将生成的电影数量减少!...</strong></p>"
- Set openfileobj=objfso.opentextfile(rootfile,8)
- openfileobj.writeline"<?xml version='1.0' encoding='UTF-8'?>"
- openfileobj.writeline"<urlset xmlns='http://www.google.com/schemas/sitemap/0.84'>"
- openfileobj.writeline"<url>"
- openfileobj.writeline"<loc>"&SiteURL&"index.html</loc>"
- openfileobj.writeline"<lastmod>"&ISO8601(DateAdd("h",-1,Now))&"</lastmod>"
- openfileobj.writeline"<changefreq>always</changefreq>"
- openfileobj.writeline"<priority>1.0</priority>"
- openfileobj.writeline"</url>"
- response.write "<p><strong style='font-family:arial,sans-serif;font-size=12'>首页索引完毕，开始索引分类页面</strong></p>"
- Dim zt_typeRows,zt_typeSql,zt_dataRows,zt_dataSql,topSql
- zt_typeSql="select zt_typeid,zt_en from zt_type order by zt_n asc"
- If num=0 Then
- topSql=""
- Else
- topSql=" top "&num&""
- End If
- zt_dataSql="select"&topSql&" zt_id,zt_date,zt_type from zt_data order by zt_date desc"
- Dim RS
- Set RS=Conn.ExeCute(zt_typeSql)
- if RS.EOF then
- ReDim zt_typeRows(0,0)
- Else
- zt_typeRows=RS.getrows()
- End If
- Set RS=Conn.ExeCute(zt_dataSql)
- if RS.EOF then
- ReDim zt_dataRows(0,0)
- Else
- zt_dataRows=RS.getrows()
- End If
- RS.close : Set RS=Nothing
- If UBound(zt_typeRows,1)>0 then
- Dim iPrior,dtNow
- dtNow = Now
- For i=0 to UBound(zt_typeRows,2)
- openfileobj.writeline" <url>"
- openfileobj.writeline" <loc>"
- openfileobj.writeline SiteURL&zt_typeRows(1,i)&"/index.html"
- openfileobj.writeline "</loc>"
- openfileobj.writeline " <lastmod>"
- openfileobj.writeline ISO8601(DateAdd("h",-1,Now))
- openfileobj.writeline "</lastmod>"
- openfileobj.writeline " <changefreq>"
- openfileobj.writeline "always"
- openfileobj.writeline "</changefreq>"
- openfileobj.writeline " <priority>"
- openfileobj.writeline "0.9"
- openfileobj.writeline "</priority>"
- openfileobj.writeline " </url>"
- Next
- End If
- response.write "<p><strong style='font-family:arial,sans-serif;font-size=12'>分类页面索引完毕，共<span style=color:#FF0000> "&i&" </span>个分类页面被索引,开始索引详细电影页面啦...</strong></p>"
- If UBound(zt_dataRows,1)>0 then
- dtNow = Now
- For j=0 to UBound(zt_dataRows,2)
- iPrior = "0.5"
- openfileobj.writeline" <url>"
- openfileobj.writeline" <loc>"
- openfileobj.writeline SiteURL&get_classenname(zt_dataRows(2,j))&"/"&zt_dataRows(0,j)&"/index.html"
- openfileobj.writeline "</loc>"
- openfileobj.writeline " <lastmod>"
- openfileobj.writeline ISO8601(zt_dataRows(1,j))
- openfileobj.writeline "</lastmod>"
- openfileobj.writeline " <changefreq>"
- If DateDiff("h", zt_dataRows(1,j), dtNow) < 24 Then
- openfileobj.writeline "hourly"
- iPrior = "0.8"
- ElseIf DateDiff("d", zt_dataRows(1,j), dtNow) < 7 Then
- openfileobj.writeline "dayly"
- iPrior = "0.7"
- ElseIf DateDiff("ww", zt_dataRows(1,j), dtNow) < 4 Then
- openfileobj.writeline "weekly"
- iPrior = "0.6"
- ElseIf DateDiff("m", zt_dataRows(1,j), dtNow) < 12 Then
- openfileobj.writeline "monthly"
- iPrior = "0.4"
- Else
- openfileobj.writeline "yearly"
- iPrior = "0.3"
- End If
- openfileobj.writeline "</changefreq>"
- If iPrior <> "0.5" Then
- openfileobj.writeline " <priority>"
- openfileobj.writeline iPrior
- openfileobj.writeline "</priority>"
- End If
- openfileobj.writeline " </url>"
- Next
- End If
- response.write "<p><strong style='font-family:arial,sans-serif;font-size=12'>电影页面索引完毕，共<span style=color:#FF0000> "&j&" </span>个电影页面被索引...</strong></p>"
- Function ISO8601(DateTime)
- Dim DateMonth,DateDay,DateHour,DateMinute,DateWeek,DateSecond
- DateMonth=Month(DateTime)
- DateDay=Day(DateTime)
- DateHour=Hour(DateTime)
- DateMinute=Minute(DateTime)
- DateWeek=weekday(DateTime)
- DateSecond=Second(DateTime)
- If Len(DateMonth)<2 Then DateMonth="0"&DateMonth
- If Len(DateDay)<2 Then DateDay="0"&DateDay
- If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
- If Len(DateHour)<2 Then DateHour="0"&DateHour
- If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
- ISO8601=Year(DateTime)&"-"&DateMonth&"-"&DateDay&"T"&DateHour&":"&DateMinute&":"&DateSecond&"+08:00"
- End Function
- openfileobj.writeline "</urlset>"
- response.write "<p><strong style='font-family:arial,sans-serif;font-size=12'>恭喜啊~~~SiteMap.xml彻底生成完毕了，共<span style=color:#FF0000> "&i+j+1&" </span>个文件被索引</strong></p>"
- set fso = nothing
- %>
|
|
发表于 2008-2-23 09:49
| 
