'last update: 2008/6/12
'1/分别解析include的file和virtual属性
'2/删除运行在服务器端的object和script标签
'3/取消了ASPEncode对资源的消耗,直接用Mid来截取html字符串,并用Execute统一执行
'get file string data
Public Function GetFileString(ByVal strPath, ByVal strCharset)
Dim objFile
Set objFile = Server.CreateObject("ADODB.Stream")
objFile.Type = 2'adTypeText
objFile.Charset = strCharset
objFile.Open
objFile.LoadFromFile strPath
GetFileString = objFile.ReadText(-1)
objFile.Close
Set objFile = Nothing
End Function
Public Sub ASPInclude(ByVal strPath, ByVal strCharset)
Dim strData
Dim reg, arr, ptr, pos
Dim tmp, ret, i
strData = GetFileString(Server.MapPath(strPath), strCharset)
Set reg = New RegExp
reg.Global = True
reg.IgnoreCase = True
'parse include file
reg.Pattern = "<!--#include/s+file=""([^""]+)""-->"
strData = reg.Replace(strData, "<" & "%ASPInclude """ & ASPPath(strPath) & "$1"", """ & strCharset & """%" & ">")
'parse include virtual
reg.Pattern = "<!--#include/s+virtual=""([^""]+)""-->"
strData = reg.Replace(strData, "<" & "%ASPInclude ""$1"", """ & strCharset & """%" & ">")
'clear object or script tag that runat server
reg.Pattern = "<(object|script)/s[^>]*?runat=""server""[^>]*>[/s/S]*?<//1>"
strData = reg.replace(strData, "")
'parse asp tag
reg.Pattern = "<" & "%([/s/S]*?)%" & ">"
Set arr = reg.Execute(strData)
If arr.Count > 0 Then
ReDim tmp(arr.Count * 2)
pos = 1
i = 0
For Each ptr In arr
If ptr.FirstIndex + 1 - pos > 0 Then
tmp(i) = "Response.Write Mid(strData, " & pos & ", " & ptr.FirstIndex + 1 - pos & ")"
i = i + 1
End If
pos = ptr.FirstIndex + 1 + ptr.Length
If Left(ptr.SubMatches(0), 1) = "=" Then'</%=*%/>
tmp(i) = "Response.Write " & Mid(ptr.SubMatches(0), 2)
Else
tmp(i) = ptr.SubMatches(0)
End If
i = i + 1
Next
tmp(i) = "Response.Write Mid(strData, " & pos & ")"
ReDim Preserve tmp(i)
ret = Join(tmp, vbCrLf)
Else
ret = "Response.Write strData"
End If
'Response.Write "<h4>Debug</h4>"
'Response.Write "<textarea cols=""90"" rows=""10"">" & Server.HTMLEncode(ret) & "</textarea>"
Execute ret
Set arr = Nothing
Set reg = Nothing
End Sub
'Translate Current Path
Private Function ASPPath(ByVal strPath)
Dim ret, tmp, pos
tmp = Replace(strPath, "/", "/")
pos = InStrRev(tmp, "/")
If pos > 0 Then
ret = Mid(tmp, 1, pos)
End If
ASPPath = ret
End Function
'Usage
ASPInclude "test/test.asp", "GBK"
ASP动态include
最新推荐文章于 2018-07-03 09:56:55 发布