asp生成静态HTML(动态读取)
程序员文章站
2022-08-10 17:54:44
复制代码 代码如下: <% call connectiond...
复制代码 代码如下:
<!--#include file="admin_checkuser.asp"-->
<%
call connectiondatabase()
dim str,str_new
str=""
str_new=""
sqlx="select id from fl_products order by id desc"
set rsx=conn.execute(sqlx)
do while not rsx.eof
str=str&rsx("id")&"|"
rsx.movenext :loop
rsx.close
sqlx="select id from fl_news order by id desc"
set rsx=conn.execute(sqlx)
do while not rsx.eof
str_new=str_new&rsx("id")&"|"
rsx.movenext :loop
rsx.close
place=instrrev(str,"|")
str=left(str,place-1)
place=instrrev(str_new,"|")
str_new=left(str_new,place-1)
dim url,cwww,act
act=trim(request.querystring("act"))
url =request.servervariables("http_host")
cwww="http://"+url
makehtm cwww&"/index.asp","../index.htm","首页写入成功！"
makehtm cwww&"/about.asp","../about.htm","企业简介写入成功！"
makehtm cwww&"/contact.asp","../contact.htm","联系我们写入成功！"
makehtm cwww&"/ry.asp","../ry.htm","资质荣誉写入成功！"
makehtm cwww&"/liuyan.asp","../liuyan.htm","联系我们写入成功！"
makehtm cwww&"/pro.asp","../pro.htm","产品展示写入成功！"
makehtm cwww&"/news.asp","../news.htm","生成车间写入成功！"
makehtm cwww&"/xinwen.asp","../xinwen.htm","新闻资讯写入成功！"
makehtm cwww&"/alliance.asp","../alliance.htm","销售网络写入成功！"
'生成产品
xstr=split(str,"|")
for i=0 to ubound(xstr)
makehtm cwww&"/uzproduct.asp?id="&xstr(i),"../uzproduct_"&xstr(i)&".htm","产品"&xstr(i)&"写入成功！"
next
xstr=split(str_new,"|")
for i=1 to ubound(xstr)/25+1
makehtm cwww&"/xinwen.asp?page="&i,"../xinwen_"&i&".htm","新闻列表"&i&"写入成功！"
next
xstr=split(str_new,"|")
for i=0 to ubound(xstr)
makehtm cwww&"/uznews.asp?id="&xstr(i),"../uznews_"&xstr(i)&".htm","新闻"&xstr(i)&"写入成功！"
next
function bytestobstr(body,cset)
dim objstream
set objstream = server.createobject("adodb.stream")
objstream.type = 1
objstream.mode =3
objstream.open
objstream.write body
objstream.position = 0
objstream.type = 2
objstream.charset = cset
bytestobstr = objstream.readtext
objstream.close
set objstream = nothing
end function
function makehtm(curl,turl,mess)
set xml = server.createobject("microsoft.xmlhttp")
'把下面的地址替换成你的首页的文件地址,一定要用http://开头的绝对路径,不能写相对路径
xml.open "get", curl, false
xml.send
bodytext=xml.responsebody
bodytext=bytestobstr(bodytext,"gb2312")
set xml = nothing
'替换
bodytext=regreplace(bodytext,"uzproduct\.asp\?id=(\d*)", "uzproduct_$1.htm")
bodytext=regreplace(bodytext,"uznews\.asp\?id=(\d*)", "uznews_$1.htm")
bodytext=regreplace(bodytext,"xinwen\.asp\?page=(\d*)", "xinwen_$1.htm")
bodytext=replace(bodytext,"index.asp","index.htm")
bodytext=replace(bodytext,"about.asp","about.htm")
bodytext=replace(bodytext,"pro.asp","pro.htm")
bodytext=replace(bodytext,"news.asp","news.htm")
bodytext=replace(bodytext,"liuyan.asp","liuyan.htm")
bodytext=replace(bodytext,"ry.asp","ry.htm")
bodytext=replace(bodytext,"xinwen.asp","xinwen.htm")
bodytext=replace(bodytext,"contact.asp","contact.htm")
dim fso, myfile
set fso = createobject("scripting.filesystemobject")
set myfile= fso.createtextfile(server.mappath(turl), true)
myfile.writeline(bodytext)
myfile.close
response.write mess
response.write "<br>"
end function
public function regreplace(scontent, spatrn, snewstr)
dim otempreg : set otempreg = new regexp
with otempreg
.ignorecase = true
.global = true
.pattern = spatrn
regreplace = .replace(scontent, snewstr)
end with
set otempreg = nothing
end function
call closedatabase()
%>
<html>
<head>
<meta http-equiv="content-type" content="text/html; charset=gb2312" />
<title>untitled document</title>
<style>
body,td{font-family:verdana, arial, helvetica, sans-serif;
font-size:10.5pt;}
</style>
</head>
<body>
</body>
</html>
来自 iisboy
上一篇： asp中的ckEditor的详细配置小结
下一篇： Asp 解析 XML并分页显示源码