asp生成静态HTML(动态读取)_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)&"写入成功！"

xstr=split(str_new,"|")

for i=1 to ubound(xstr)/25+1

MakeHtm cwww&"/xinwen.asp?Page="&i,"../xinwen_"&i&".htm","新闻列表"&i&"写入成功！"

xstr=split(str_new,"|")

for i=0 to ubound(xstr)

MakeHtm cwww&"/uzNews.asp?id="&xstr(i),"../uzNews_"&xstr(i)&".htm","新闻"&xstr(i)&"写入成功！"

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>

<title>Untitled Document</title>

<style>

body,td{font-family:Verdana, Arial, Helvetica, sans-serif;

font-size:10.5pt;}

</style>

</head>

<body>

</body>

</html>

来自 iisboy