ff

最新推荐文章于 2024-09-26 10:53:28 发布

xiangyalan321

最新推荐文章于 2024-09-26 10:53:28 发布

阅读量288

点赞数

文章标签： class sql url vbscript file encoding

本文链接：https://blog.csdn.net/xiangyalan321/article/details/5494832

版权

<%
if session("ttpyy789123")="" then
response.redirect "../index.asp"
response.end
end if
%>



<%
'=====================生成txt地图开始=======================

okfile = site_url & "/" & "index" & site_endname & vbcrlf

set rs=server.createobject("adodb.recordset")
sql="select * from [single]"
rs.open sql,conn,1,1
if not rs.eof then
do while not rs.eof
class_fpath=rs("class_fpath")
class_fname=rs("class_fname")
fname=rs("fname")
fpath=""
if class_fpath<>"" then
fpath="/"&class_fpath
end if
if class_fname<>"" then
fpath=fpath&"/"&class_fname
end if

okfile = okfile & site_url & fpath & "/" & rs("fname") & site_endname & vbcrlf
rs.movenext
loop
end if
rs.close

sql="select * from [product_class]"
rs.open sql,conn,1,1
if not rs.eof then
do while not rs.eof
okfile = okfile & site_url & getclasspath_p(rs("class_id")) & vbcrlf
rs.movenext
loop
end if
rs.close

sql="select * from [product]"
rs.open sql,conn,1,1
if not rs.eof then
do while not rs.eof
okfile = okfile & site_url & getclasspath_p(rs("class_id")) & rs("fname") & site_endname & vbcrlf
rs.movenext
loop
end if
rs.close

sql="select * from [news_class]"
rs.open sql,conn,1,1
if not rs.eof then
do while not rs.eof
okfile = okfile & site_url & getclasspath(rs("class_id")) & vbcrlf
rs.movenext
loop
end if
rs.close

sql="select * from [news]"
rs.open sql,conn,1,1
if not rs.eof then
do while not rs.eof
okfile = okfile & site_url & getclasspath(rs("class_id")) & rs("fname") & site_endname & vbcrlf
rs.movenext
loop
end if
rs.close

'======图片地图开始=====
sql="select * from [product]"
rs.open sql,conn,1,1
if not rs.eof then
do while not rs.eof
okfile = okfile & site_url & rs("spic") & vbcrlf
rs.movenext
loop
end if
rs.close

sql="select * from [product]"
rs.open sql,conn,1,1
if not rs.eof then
do while not rs.eof
okfile = okfile & site_url & rs("pic") & vbcrlf
rs.movenext
loop
end if
rs.close
'======图片地图结束=====

Set fso = Server.CreateObject("Scripting.filesystemobject")

fname="sitemap.txt"
Set fout = fso.Createtextfile(server.mappath("../../"&fname),true)
fout.writeline okfile
fout.close

'=====================生成txt地图结束=======================

  response.write "<script>alert('生成txt站点地图成功!');history.go(-1);</script>"
  response.end
%>

<% @ language = "vbscript" codepage = "65001" %>
<% Response.CharSet = "UTF-8" %>
<% Session.CodePage = "65001" %>
<% Server.ScriptTimeOut = 9999 %>


<%

Dim objFso,objFolder,colFiles,objFile

Set objFso = CreateObject("Scripting.FileSystemObject")
Dim Str
Strhead = "<?xml version=""1.0"" encoding=""UTF-8""?>" & vbcrlf
Strhead = Strhead & "<urlset xmlns=""http://www.google.com/schemas/sitemap/0.84"" xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xsi:schemaLocation=""http://www.google.com/schemas/sitemap/0.84 http://www.google.com/schemas/sitemap/0.84/sitemap.xsd"">" & vbcrlf
Strend="</urlset>"
set rs=conn.execute("select add_time,class_id,fname from news order by id asc")
stra=""
i=0
j=1
if not rs.eof then
do while not rs.eof
if i=2000 then
call createxml(Strhead&stra&Strend,j)
stra=""
j=j+1
i=0
end if
i=i+1
stra=stra&"<url>" & vbcrlf & "<loc>"&site_url&"/"&getpath(rs("class_id"))&"/"&rs("fname")&".htm</loc>"& vbcrlf & "<lastmod>" & gettimeformat(rs("add_time")) & "</lastmod>" & vbcrlf & "<changefreq>daily</changefreq>" & vbcrlf & "</url>"
if i=2000 then
call createxml(Strhead&stra&Strend,j)
stra=""
j=j+1
i=0
end if
rs.movenext
loop
if i<>2000 then
call createxml(Strhead&stra&Strend,j)
end if
end if

Set objFso = Nothing

If Err.Number = 0 Then
response.write("<script>alert('恭喜!生成站点地图成功!');history.go(-1);</script>")
response.end
Else
response.write("<script>alert('抱歉!生成站点地图失败!');history.go(-1);</script>")
response.end
End If

function createxml(str,j)
Dim objStream
Set objStream = Server.CreateObject("ADODB.Stream")
With objStream
.Open
.Charset = "UTF-8"
.Position = objStream.Size
.WriteText = Str
.SaveToFile Server.MapPath("/sitemap_"&j&".xml"),2
.Close
End With
Set objStream = Nothing
end function

function gettimeformat(times)
tim=formatdatetime(times,2)
timt=split(tim,"-")
if len(timt(1))=1 then
timt(1)="0"&timt(1)
end if
if len(timt(2))=1 then
timt(2)="0"&timt(2)
end if
gettimeformat=timt(0)&"-"&timt(1)&"-"&timt(2)
end function

function getpath(id)
if id<>"" or id <>0 or id<>"0" then
set rs2=conn.execute("select class_fname from news_class where class_id="&id&"")
if not rs2.eof then
getpath=rs2(0)
else
getpath=""
end if

end if
end function