一个不太完善的ASP整站静态生成程序

 

一个不太完善的ASP整站静态生成程序

 

<%
'**************************************************************************************************'
'                                 大路整站静态生成程序              '
'                                   by     吕鑫                   '
'                                   date   2006.3.30                                               '
'                               http://www.dalu2000.com                                       '
'***************************************************************************************************
const def_page = "index.asp"   '定义程序开始读取的页面
const html_url = "html"     '定义静态程序存放的目录
const html_flag = 0      '0为只生成没有的,1为全部重新生成
const temp_name = "~temp.html"   '临时文件名称

dim dalu,fsoname
set dalu = new allhtml
call dalu.page_load()
'**************************************************************************************************** 
class allhtml

 Function IsObjInstalled(strClassString)
  On Error Resume Next
  IsObjInstalled = False
  Err = 0
  Dim xTestObj
  Set xTestObj = Server.CreateObject(strClassString)
  If 0 = Err Then IsObjInstalled = True
  Set xTestObj = Nothing
  Err = 0
 End Function

 sub page_load()
  fsoname = checkfso()
  'call deltemp()
  'response.Write("删除OK")
  'response.End()
  'on error resume next
  call getfile(def_page)
  'call checkurl(html_url)
 end sub
 
 Function checkfso()
  '为了兼容服务器上不同名的FSO
  if IsObjInstalled("scripting.daluabc2000fso") then
   checkfso = "scripting.daluabc2000fso"
  else
   checkfso = "scripting.filesystemobject"
  end if
 end Function
 
 sub getfile(def_page)
  dim content,fso,ts
  response.Write def_page&"<br />"
  call asptohtm(def_page)
  '读取文件
  set fso = server.CreateObject(fsoname)
  set ts = fso.OpenTextFile(server.MapPath(html_url&"/"&temp_name),1)
  content = ts.ReadAll
  '释放内存
  set fso = nothing
  set ts = nothing
  '正则判断内容里面是否有链接并替换
  content = chglink(content,def_page)
 end sub
 
 sub writefile(content,page_url)
  '把内容写入静态页面
  set fso = server.CreateObject(fsoname)
  set ts_w = fso.OpenTextFile(server.MapPath(page_url),2,true)
  ts_w.write content 
  '释放内存
  set fso = nothing
  set ts_w = nothing
 end sub
 
 sub deltemp()
  set fso = server.CreateObject(fsoname)
  if fso.fileExists(server.MapPath(html_url&"/"&temp_name)) then
   fso.deletefile(server.MapPath(html_url&"/"&temp_name))
  end if 
  set fso = nothing
 end sub
 
 function checkfile(page_url)
  set fso = server.CreateObject(fsoname)
  if fso.fileExists(server.MapPath(page_url)) then
   checkfile = false
  else
   checkfile = true
  end if
  '释放内存
  set fso = nothing
 end function
 
 function chglink(content,page_url)
  Dim regEx,Matches,match,str,j
  dim part1,part2,part3,part4,part5 '文件名及后缀
  dim html_name
  j = 0
  str = "href="&chr(34)&"([^ /s/t/r/n.:;>"&chr(34)&"]+).([^ /t/r/n.:;>"&chr(34)&"]+)"&chr(34)&"" '设置模板

  content = CheckExp(str,content,"href="&chr(34)&"$1.$2"&chr(34)&"")
  Set regEx=New RegExp    '建立一个新对像
  regEx.Pattern=str     '设置模板 
  regEx.IgnoreCase=true    '搜索是否区分大小写的 true表是不区分 flase表示区分
  regEx.Global=True     '搜索是否应用于整个字符串
  
  set Matches = regEx.execute(content)
    
  for each match in Matches
   part1 = CheckExp(str,match.value,"$1")
   part2 = CheckExp(str,match.value,"$2")
   part4 = part1&"."&part2
   part3 = part1&tohtml(part2)
   '替换链接地址为静态
   content = replace(content,chr(34)&part4&chr(34),chr(34)&part3&chr(34))
  next
  
  page_url = split(page_url,".")
  html_name = page_url(0)&tohtml(page_url(1))
  response.Write "生成静态页面"&html_url&"/"&html_name&"<br />"
  call writefile(content,html_url&"/"&html_name)
  
  for each match in Matches
   part1 = CheckExp(str,match.value,"$1")
   part2 = CheckExp(str,match.value,"$2")
   part4 = part1&"."&part2
   part3 = part1&tohtml(part2)
   '递归遍历所有链接
   '判断文件是否已经生成
   if instr(part4,"asp") then
    if checkfile(html_url&"/"&part3) then
     call getfile(part4)
    end if
   end if
  next
  
  chglink = content
 end function
 
 function tohtml(key)
  dim temp
  '静态页面生成规则
  if instr(key,"css") or instr(key,"js") or instr(key,"html") or instr(key,"htm") or instr(key,"jpg") or instr(key,"gif")  then
   key = "."&key
  elseif instr(key,"?") then  
   if instr(key,"&") then
    key = replace(replace(replace(key,"asp?","_"),"=",""),"&","_")&".html"
   else
    key = replace(replace(replace(key,"asp?","_"),"=",""),"&","_")&".html"
   end if
  elseif instr(key,"asp") then
   key = ".html"
  else
   key = key
  end if
  tohtml = key
 end function
 
 Function CheckExp(patrn,strng,tagstr)
  Dim regEx,Matches

  Set regEx=New RegExp     '建立一个新对像
  regEx.Pattern=patrn      '设置模板
  regEx.IgnoreCase=true     '搜索是否区分大小写的 true表是不区分 flase表示区分
  regEx.Global=True      '搜索是否应用于整个字符串
   
  Matches=regEx.replace(strng,tagstr)  '匹配并替代字符串
    
  CheckExp=Matches      '返回函数结果
 end function 
 
 function bin2str(bin)
  dim tmp,ustr
   tmp=""
  for i=1 to LenB(bin)-1
   ustr=AscB(MidB(bin,i,1))
   if ustr>127 then
    i=i+1
    tmp=tmp&chr(ustr*256+AscB(MidB(bin,i,1)))
   else
    tmp=tmp&chr(ustr)
   end if
  next
  bin2str=tmp
 end function
 
 sub asptohtm(strUrl)
  'strUrl = geturl(http://www.blog.com.cn/strUrl)
  '读取页面生成静态页面
  dim objXmlHttp,objAdoStream
  
  set objXmlHttp = Server.CreateObject("MSXML2.XMLHTTP")
   objXmlHttp.open "POST",geturl(http://www.blog.com.cn/strUrl),false
   objXmlHttp.send()
   
   binFileData = objXmlHttp.responseBody
  
  '判断是否临时文件是否存在
  'call deltemp()

  set objAdoStream = Server.CreateObject("ADODB.Stream")
   objAdoStream.Type = 1
   objAdoStream.Open
   objAdoStream.Write(binFileData)
   objAdoStream.SaveToFile Server.MapPath(html_url&"/"&temp_name),2
   objAdoStream.Close
   
  set objXmlHttp = nothing
  set objAdoStream = nothing
 end sub
 
 function geturl(http://www.blog.com.cn/strUrl)
  dim tem_ary,tem_url
  tem_url = request.ServerVariables("url")
  tem_ary = split(request.ServerVariables("url"),"/")
  tem_url = replace(tem_url,"/"&tem_ary(ubound(tem_ary)),"")
  
  geturl = "http://"&request.ServerVariables("SERVER_NAME")&tem_url&"/"&strUrl
 end function
 
end class
%>