动态调用#include——老外的代码

<%
  public dyninclude, include_vars, include_vars_count
  dim objfschk
  
  set dyninclude = new cls_include
  set objfschk = server.createobject("scripting.filesystemobject")
  set regFltr = new regexp
  set regFltr2 = new regexp
  
  class cls_include

    private sub class_initialize()
      set include_vars = server.createobject("scripting.dictionary")
   include_vars_count = 0
    end sub
    private sub class_deactivate()
      include_vars.removeall
      set include_vars = nothing
      set include = nothing
    end sub

    public default function dyninclude(byval str_path)
      dim str_source
      if str_path <> "" then
  
    if (instr(str_path,":") > 0) then
   init_path = str_path
  else
   init_path = server.mappath(str_path)
  end if
  
        str_source = readfile(str_path)
        if str_source <> "" then
          str_source = processincludes (str_source, init_path, 0)
          convert2code str_source
          formatcode str_source
          if str_source <> "" then
'            if request.querystring("debug") = 1 then
'              response.write str_source
'              response.end
'            else
    executeglobal str_source
'            end if
          end if
        end if
      end if
    end function

    private sub convert2code(str_source)
      dim i, str_temp, arr_temp, int_len, basecount
   basecount = include_vars_count
      if str_source <> "" then
        if instr(str_source,"%" & ">") > instr(str_source,"<" & "%") then
          str_temp = replace(str_source,"<" & "%","?")
          str_temp = replace(str_temp,"%" & ">","?)
          if left(str_temp,1) = "? then str_temp = right(str_temp,len(str_temp) - 1)
          if right(str_temp,1) = "? then str_temp = left(str_temp,len(str_temp) - 1)
          arr_temp = split(str_temp,"?)
          int_len = ubound(arr_temp)
          if (int_len + 1) > 0 then
            for i = 0 to int_len
              str_temp = arr_temp(i)
              str_temp = replace(str_temp,vbcrlf & vbcrlf,vbcrlf)
              if left(str_temp,2) = vbcrlf then str_temp = right(str_temp,len(str_temp) - 2)
              if right(str_temp,2) = vbcrlf then str_temp = left(str_temp,len(str_temp) - 2)
              if left(str_temp,1) = "%" then
                str_temp = right(str_temp,len(str_temp) - 1)
                if left(str_temp,1) = "=" then
                  str_temp = right(str_temp,len(str_temp) - 1)
                  str_temp = "response.write " & str_temp
                end if
              else
                if str_temp <> "" then
      include_vars_count = include_vars_count + 1
                  include_vars.add include_vars_count, str_temp
                  str_temp = "response.write include_vars.item(" & include_vars_count & ")"
                end if
              end if
              if right(str_temp,2) <> vbcrlf then str_temp = str_temp
              arr_temp(i) = str_temp
            next
            str_source = join(arr_temp,vbcrlf)
          end if
        else
          if str_source <> "" then
            include_vars.add "var", str_source
            str_source = "response.write include_vars.item(""var"")"
          end if
        end if
      end if
    end sub

    private function processincludes(tmp_source, curdir, curdepth)
      dim int_start, str_path, str_mid, str_temp, localdir
  
   if (curdepth < 20) then ' Maximum allowable depth.  Just in case we get two files including each other
  
    localdir = left(curdir, len(curdir)-len(objfschk.GetFileName(curdir)))
       tmp_source = replace(tmp_source,"<!-- #","<!--#")
       int_start = instr(tmp_source,"<!--#include")
       str_mid = lcase(getbetween(tmp_source,"<!--#include","-->"))

       do until int_start = 0
         str_mid = lcase(getbetween(tmp_source,"<!--#include","-->"))
  
   if (str_mid <> "") then int_start = 1
         if int_start >  0 then
           str_method = lcase(trim(getbetween(str_mid," ","=")))
           str_temp = lcase(getbetween(str_mid,chr(34),chr(34)))
           str_temp = trim(str_temp)
    
     if (str_method = "file") then
      newdir = objfschk.BuildPath(localdir,replace(str_temp,"/","\"))

    str_path = processincludes(readfile(newdir), newdir, curdepth+1)
    tmp_source = replace(tmp_source,"<!--#include" & str_mid & "-->",str_path & vbcrlf)
    
     elseif (str_method = "virtual") then
    
      newdir = server.mappath(str_temp)

    str_path = processincludes(readfile(newdir), newdir)
    tmp_source = replace(tmp_source,"<!--#include" & str_mid & "-->",str_path & vbcrlf)
     else
    tmp_source = replace(tmp_source,"<!--#include" & str_mid & "-->","" & vbcrlf)
     end if
    
         end if
  
         int_start = instr(tmp_source,"<!--#include")
       loop

    processincludes = tmp_source
   else  
    processincludes = ""
   end if
  
    end function

    private sub formatcode(str_code)
      dim i, arr_temp, int_len
      str_code = replace(str_code,vbcrlf & vbcrlf,vbcrlf)
      if left(str_code,2) = vbcrlf then str_code = right(str_code,len(str_code) - 2)
      str_code = trim(str_code)
      if instr(str_code,vbcrlf) > 0 then
        arr_temp = split(str_code,vbcrlf)
        for i = 0 to ubound(arr_temp)
          arr_temp(i) = ltrim(arr_temp(i))
          if arr_temp(i) <> "" then arr_temp(i) = arr_temp(i) & vbcrlf
        next
        str_code = join(arr_temp,"")
        arr_temp = vbnull
      end if
    end sub

    private function readfile(str_path)
      dim objfile
      if str_path <> "" then
        if instr(str_path,":") = 0 then str_path = server.mappath(str_path)
        if objfschk.fileexists(str_path) then
          set objfile = objfschk.opentextfile(str_path, 1, false)
          if err.number = 0 then
     if (not objfile.AtEndOfStream) then
             readfile = objfile.readall

    ' Begin big elaborate mess of code designed to safely remove vbscript comments
    regFltr.Global = True
    regFltr.IgnoreCase = True
    regFltr.Pattern = "<%[^=](.|\n)*?%" & ">"
    
    regFltr2.Global = True
    regFltr2.IgnoreCase = True
    regFltr2.Pattern = """.*?"""
    
    Set Matches = regFltr.Execute(readfile)

    pEnd = 0
    pStart = 1
    str_temp_new = ""
    For Each Match in Matches

     pEnd = Match.FirstIndex + 1
     if (pEnd <> pStart) then
      str_temp_new = str_temp_new & Mid(readfile, pStart, pEnd - pStart)
      pStart = pEnd
     end if  
    
     Set Matches2 = regFltr2.Execute(Match.Value)
    
     pEnd2 = 0
     pStart2 = 1
     cpystr = ""
    
     For Each Match2 in Matches2
      pEnd2 = Match2.FirstIndex + 1
      if (pEnd2 <> pStart2) then
       cpystr = cpystr & Mid(Match.Value, pStart2, pEnd2 - pStart2)
       pStart2 = pEnd2
      end if  
      cpystr = cpystr & replace(Match2.value,"'","?)
      pEnd2 = pStart2 + Match2.length
      pStart2 = pEnd2
     next

     if (pEnd2 < len(Match.Value)) then
      pEnd2 = len(Match.Value)+1
      cpystr = cpystr & Mid(Match.Value, pStart2, pEnd2 - pStart2)
     end if      
    
     Set Matches2 = nothing
    
        regFltr.Pattern = "'.*?\n"
     str_temp_new = str_temp_new & regFltr.Replace(cpystr,vbcr)
    
     pEnd = pStart + Match.length
     pStart = pEnd
    Next
    
    if (pEnd < len(readfile)) then
     pEnd = len(readfile)+1
     str_temp_new = str_temp_new & Mid(readfile, pStart, pEnd - pStart)
    end if      
    
    readfile = replace(str_temp_new,"?,"'")
    
   else
    readfile = ""
   end if
            objfile.close
          end if
          set objfile = nothing
        end if
      end if
    end function

    private function getbetween(strdata, strstart, strend)
      dim lngstart, lngend
      lngstart = instr(strdata, strstart) + len(strstart)
      if (lngstart <> 0) then
        lngend = instr(lngstart, strdata, strend)
        if (lngend <> 0) then
          getbetween = mid(strdata, lngstart, lngend - lngstart)
        end if
      end if
    end function

  end class
%>