asp生成静态HTML(动态读取)

复制代码 代码如下:

  <!--#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