找回密码
 立即注册

QQ登录

只需一步,快速开始

查看: 2013|回复: 0
打印 上一主题 下一主题

asp生成google网站地图的xml源代码

[复制链接]

2652

主题

2652

帖子

7872

积分

论坛元老

Rank: 8Rank: 8

积分
7872
跳转到指定楼层
楼主
发表于 2018-2-18 04:48:50 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式

                  
Dim str,objStream
str = "" & vbcrlf
str = str & "" & vbcrlf
str = str & getfilelink & vbcrlf
str = str & "
" & vbcrlf
Set objStream = Server.CreateObject("ADODB.Stream")
With objStream
.Open
.Charset = "UTF-8"
.Position = objStream.Size
.WriteText=str
.SaveToFile server.mappath("sitemap.xml"),2
.Close
End With
Set objStream = Nothing
If Not Err Then
   Response.Redirect("sitemap.xml")
   Response.End
End If
Function getfilelink()
   SQL="SELECT * FROM 表名 ORDER BY id DESC"
   Dim RS
   Set RS=Server.CreateObject("ADODB.RecordSet")
   RS.Open SQL,Conn,1,1
   IF RS.EOF AND RS.BOF Then
      Response.Write("")
   Else
      Do While NOT RS.EOF
   Y=year(RS("intime"))
   if len(month(RS("intime")))=1 then
   M=0&month(RS("intime"))
   else
   M=month(RS("intime"))
   end if
   if len(day(RS("intime")))=1 then
   D=0&day(RS("intime"))
   else
   D=day(RS("intime"))
   end if
          getfilelink = getfilelink & "http://www.mycodes.net/html/"&RS("Classid")&"/"&RS("ID")&".Html"&Y&"-"&M&"-"&D&""&RS("Title")&"1.0"
          RS.MoveNext
      Loop
   End IF
RS.Close
Set RS=Nothing
Conn.Close
Set Conn=Nothing
End Function
%>
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

用户反馈
客户端