自己写的ASP模板解析程序，比较烂

<%
'**************************************************************************************************'
'                                 大路网络模板解析程序              '
'                                   by     吕鑫                   '
'                                   date   2006.3.10                                               '
'                               http://www.dalu2000.com                                       '
'***************************************************************************************************

class dalutemp

 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 getfile(filename,path)
  dim fso,ts,ts_c,ts_w,ts_e
  dim newfilename,content
  dim temp_path,code_path,code
 
  temp_path = "template"
  code_path = "include"
  code = "code"
  
  '读取文件
  if IsObjInstalled("scripting.daluabc2000fso") then
   set fso = server.CreateObject("scripting.daluabc2000fso")
  else
   set fso=server.CreateObject("scripting.filesystemobject")
  end if
  set ts = fso.OpenTextFile(server.MapPath(temp_path&"/"&path&"/"&filename),1)
  content = ts.ReadAll
  '如果文件夹不存在则创建
  if not fso.FolderExists(server.MapPath(code_path&"/"&path)) then
   fso.CreateFolder(server.MapPath(code_path&"/"&path))
  end if
  '生成动态文件
  filename = split(filename,".")
  newfilename = filename(0)&".asp"  
  fso.createtextfile(server.MapPath(code_path&"/"&path&"/"&newfilename))
  '正则修改
  content = toasp(content,server.MapPath(temp_path&"/"&path&"/"))
  '加页面数据操作读取
  set ts_c = fso.OpenTextFile(server.MapPath(code&"/"&newfilename),1)
  content = ts_c.ReadAll&content
  set ts_e = fso.OpenTextFile(server.MapPath(code&"/close.asp"),1)
  content = content&ts_e.ReadAll
  '把动态内容写入
  set ts_w = fso.OpenTextFile(server.MapPath(code_path&"/"&path&"/"&newfilename),2,true)
  ts_w.write content  
  '释放内存
  set fso = nothing
  set ts = nothing
  set ts_c = nothing
  set ts_w = nothing
  set ts_e = nothing
  'call getsub(code_path&"/"&path&"/"&filename(0),"cache")
  server.Execute(code_path&"/"&path&"/"&newfilename)
 end sub
 
 sub getsub(i,path)
  
    dim FileName,FilePath,FilePath1,Do_Url,TrueUrl,PageUrl,LeftPageUrl,j,PageUrl1,TrueUrl1
    dim do_i
   
    '读取该执行文件
    PageUrl = "Http://"&Request.ServerVariables("SERVER_NAME")
    PageUrl = PageUrl&Request.ServerVariables("URL")
    PageUrl = split(PageUrl,"/")
    for j = 0 to Ubound(PageUrl)-1
    TrueUrl = TrueUrl&PageUrl(j)&"/"
    next
   
    PageUrl1 = split(Request.ServerVariables("URL"),"/")
   
    for j = 0 to Ubound(PageUrl1)-1
    TrueUrl1 = TrueUrl1&PageUrl1(j)&"/"
    next 
   
    Do_url = TrueUrl&i&".asp"
   
    do_i = split(i,"/")
    i = ""
    for j = 0 to Ubound(do_i)-1
    i = i&do_i(j)&"/"
    next
    i = i&path&"/"&do_i(j)
   
    FilePath1 = Server.MapPath("/")&TrueUrl1&i&".html"
   
    call asptohtm(Do_Url,FilePath1)
 end sub
 
 sub asptohtm(strUrl,FilePath)
  dim objXmlHttp
  set objXmlHttp = Server.CreateObject("MSXML2.XMLHTTP")
   objXmlHttp.open "POST",strUrl,false
   objXmlHttp.send()

  Dim binFileData
   binFileData = objXmlHttp.responseBody
   
  Dim objAdoStream
  set objAdoStream = Server.CreateObject("ADODB.Stream")        
   objAdoStream.Type = 1
   objAdoStream.Open()
   objAdoStream.Write(binFileData)
   objAdoStream.SaveToFile  FilePath,2
  
  objAdoStream.Close()
  set objAdoStream = nothing 
  set objXmlHttp = nothing 
 end sub
 
 function toasp(content,path)
  content = replace_include(content,path)
  content = replace_string(content)
  content = replace_loop(content)
  content = replace_loopstring(content)
  toasp = content
 end function
 
 function replace_loop(content)
  dim re,aspstr
  re="/<dalu:loop id='([^ /t/r/n']+)'>"
  
  aspstr = ""
  aspstr = aspstr&"<"&chr(37)&vblf
  aspstr = aspstr&"set $1 = server.CreateObject("&chr(34)&"adodb.recordset"&chr(34)&")"&vblf
  aspstr = aspstr&"$1.open $1_query,conn,1,1"&vblf
  aspstr = aspstr&"sql_num = sql_num + 1"&vblf
  aspstr = aspstr&"if $1.eof then"&vblf
  aspstr = aspstr&"response.Write("&chr(34)&"暂无记录"&chr(34)&")"&vblf
  aspstr = aspstr&"else"&vblf
  aspstr = aspstr&"do while not $1.eof"&vblf
  aspstr = aspstr&chr(37)&">"&vblf
  
  content=checkexp(re,content,aspstr)
  replace_loop = content
  
  re="/</dalu:loop id='([^ /t/r/n']+)'>"
  
  aspstr = ""
  aspstr = aspstr&"<"&chr(37)&vblf
  aspstr = aspstr&"$1.movenext"&vblf
  aspstr = aspstr&"loop"&vblf
  aspstr = aspstr&"end if"&vblf
  aspstr = aspstr&"$1.close"&vblf
  aspstr = aspstr&"set $1 = nothing"&vblf
  aspstr = aspstr&chr(37)&">"&vblf
  
  content=checkexp(re,content,aspstr)
  
  re="/<dalu:loop_page id='([^ /t/r/n']+)' pagenum='([^ /t/r/n']+)'>"
  
  aspstr = ""
  aspstr = aspstr&"<"&chr(37)&vblf
  aspstr = aspstr&"set $1 = server.CreateObject("&chr(34)&"adodb.recordset"&chr(34)&")"&vblf
  aspstr = aspstr&"$1.open $1_query,conn,1,1"&vblf
  aspstr = aspstr&"PageNum = $2"&vblf
  aspstr = aspstr&"record_num = 0"&vblf
  aspstr = aspstr&"if $1.eof then"&vblf
  aspstr = aspstr&"response.Write("&chr(34)&"no record"&chr(34)&")"&vblf
  aspstr = aspstr&"else"&vblf
  aspstr = aspstr&"record_num = $1.recordcount"&vblf
  aspstr = aspstr&"sql_num = sql_num + 1"&vblf
  aspstr = aspstr&"j = 0"&vblf
  aspstr = aspstr&"$1.move $2*page_count"&vblf
  aspstr = aspstr&"do while not $1.eof"&vblf
  aspstr = aspstr&"j = j + 1"&vblf
  aspstr = aspstr&"if j > $2 then exit do"&vblf
  aspstr = aspstr&chr(37)&">"&vblf
  
  content=checkexp(re,content,aspstr)
  replace_loop = content
  
  re="/</dalu:loop_page id='([^ /t/r/n']+)'>"
  
  aspstr = ""
  aspstr = aspstr&"<"&chr(37)&vblf
  aspstr = aspstr&"$1.movenext"&vblf
  aspstr = aspstr&"loop"&vblf
  aspstr = aspstr&"$1.close"&vblf
  aspstr = aspstr&"set $1 = nothing"&vblf
  aspstr = aspstr&"end if"&vblf
  aspstr = aspstr&chr(37)&">"&vblf
  
  content=checkexp(re,content,aspstr)
  
  re="/<dalu:page/>"
  
  aspstr = ""
  aspstr = aspstr&"<"&chr(37)&vblf
  aspstr = aspstr&"call pagetable()"&vblf
  aspstr = aspstr&chr(37)&">"&vblf
  
  content=checkexp(re,content,aspstr)
  replace_loop = content
 end function
 
 function replace_loopstring(content)      
  dim re
  re="/{([^ /t/r/n}.]+)/.([^ /t/r/n}.]+)/}"
  content=checkexp(re,content,"<"&chr(37)&"=$1("&chr(34)&"$2"&chr(34)&")"&chr(37)&">")
  replace_loopstring = content
 end function
 
 function arraycheck(str,query)
  response.Write query
  response.End()
 end function
 
 function replace_string(content)
  dim re
  re="/{([^ /t/r/n}.]+)/}"
  content=checkexp(re,content,"<"&chr(37)&"=$1"&chr(37)&">")
  replace_string = content
 end function
 
 function replace_include(content,path)
  Dim regEx,Matches,match

  Set regEx=New RegExp          '建立一个新对像
  regEx.Pattern="<!--/s+dalu_([^ /t/r/n]+)/s+-->" '设置模板
  regEx.IgnoreCase=true          '搜索是否区分大小写的 true表是不区分 flase表示区分
  regEx.Global=True           '搜索是否应用于整个字符串
  
  set Matches = regEx.execute(content)
  for each match in Matches
   content = replace(content,match.value,getcontent(match.value,path))
  next
  
  replace_include = content
 end function
 
 function getcontent(path,serverpath)
  dim re
  re="<!--/s+dalu_([^ /t/r/n]+)/s+-->"
  path=serverpath&"/"&checkexp(re,path,"$1.html")

  dim fso,ts,content
  '读取文件
  if IsObjInstalled("scripting.daluabc2000fso") then
   set fso = server.CreateObject("scripting.daluabc2000fso")
  else
   set fso=server.CreateObject("scripting.filesystemobject")
  end if
  set ts = fso.OpenTextFile(path,1)
  content = ts.ReadAll
  set ts = nothing
  getcontent = content
 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

end class
%>