将ASP原生代码编译生成静态类
老早就说放弃ASP了，但这段时间以来因为工作需要，始终放不下。这不，最近又写了个东西出来，分享一下。
这个标题有点纠结，实在不知道该起个什么名字。功能上来讲，它是将原生的ASP代码编译后返回ASP执行的结果，这个结果就是打开ASP页面看到的html代码，写这个功能是忽然想到可以借这个方法生成静态，不必创建一个XMLHttp请求对原生的ASP实施静态生成
将这些文件解压到一个文件夹内
可以在浏览器访问到的
1.访问Test.asp,这个结果为直接运行ASP文件的结果
2.访问CompileTest.asp 这个结果为编译ASP文件后输出的结果,并且可以生成静态文件
用途：
1.用于ASP编写的页面生成静态
相对于传统方法生成静态文件需要用到XMLHttp组件，从外部网络访问获取到内容，再创建文件
最重要的是减少了网络延迟，解决了部分服务器不支持组件，或者不支持自身的WEB访问
对服务器压力是否有减少并没有做过测试，理论上说这种方式只是一个会话就可以生成文件，传统的方式要从web访问，至少增加了一倍的会话量
2.用于ASP模板套用及解析
ASP在这方面一直是弱项，也有不少成熟的模板引擎，但有一大部分是编译型，而不是解释型，编译型模板引擎是将ASP模板代码编译成原生的ASP代码，再执行。我之前也发布过一个解释型模板引擎，自己还是比较满意的，但不方便的是使用的人，需要另外学习模板语法，虽然简单，对于不熟悉程序的设计师来说，不如懂一点ASP就好的
必要文件:
xCompile.Class.asp
xDictionary.Class.asp
其它均为测试用文件
需要注意的问题：
1.设定好预包含文件和忽略文件
预包含文件为必须的功能性文件，不包含任何html代码输出，一般是类集或函数集
忽略的文件一般是当前的文件已经包含过的文件
2.参数问题
只考虑了Request.QueryString参数，并且只支持编译文档内的参数
不支持函数中的参数
3.其它问题欢迎反馈至 shirne@126.com
测试代码:
<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<!--#Include file="xDictionary.Class.asp"-->
<!--#Include file="xCompile.Class.asp"-->
<%
Dim C
Set C=New xCompile
'//这个文件会被预先运行,文件路径写法不重要，比较时是按实际磁盘路径比较的
C.AddInclude "TestFunctions.asp"
'//ASP中调用到这个函数的地方会被替换成字符串连接
C.AddOutFun "Echo"
C.Param("param")="这是传过去的参数"
'//编译文件
C.Compile "Test.asp"
C.Clear
'//保存编译后的文件到内容
C.SaveTo "index.html"
'//输出编译后的内容
Response.Write C
%>
原代码如下(老规矩，里面的一些关键字因服务器禁止，替换了个中文字符)：
'+++++++++++++++++++++++++++++++++++
'ASP编译类
'可按设定直接将ASP文件编译运行返回结果
'在原生ASP中用来生成静态文件，而不采用获取Http页面的方法
'shirne@126.com
'http://www.shirne.com
'+++++++++++++++++++++++++++++++++++
Class xCompile
Private Includes '预包含文件
Private Ignores '忽略的包含文件
Private OutFun '输出函数
Private strHtml '最终的HTML字符串
Private Params '参数,仅支持QueryString参数,生成静态不建议使用其它参数
Private FuncStr '定义的全局函数名
Private Classes '已加载的类列表,ASP中类不能重复加载
Private Prepared
Private Sub Class_Initialize
OutFun = Array("Response.Write")
FuncStr = "Outer__Html__Str"
Set Classes=Server.ＣreateObject("Scripting.Dictionary")
Classes.CompareMode=1
Set Params=new xDictionary
Params.Init Request.QueryString
Prepared = -1
End Sub
Private Sub Class_Terminate
Classes.RemoveAll
Set Classes= Nothing
Set Params = Nothing
End Sub
Public Default Property Get Html
Html = strHtml
End Property
'主要动作是处理预包含文件
Public Property Get Prepare
If IsArray(Includes) Then
Dim i,L:L=UBound(Includes)
If Prepared>=L Then Exit Property
For i=Prepared+1 To L
Require Includes(i)
Next
Prepared = L
End If
End Property
'添加/获取参数
Public Property Let Param(key, val)
Params.Replace key,val
End Property
Public Property Get Param(key)
Param = Params(key)
End Property
'添加预包含文件
Public Sub AddInclude( File)
Includes = Merge(Includes,CheckTruePath(File))
End Sub
'添加忽略文件
Public Sub AddIgnore( File)
Ignores = Merge(Ignores,CheckTruePath(File))
End Sub
'添加输出函数
Public Sub AddOutFun( Fun)
OutFun = Merge(OutFun,Fun)
End Sub
'保存
Public Sub SaveTo( path)
WriteFile path, strHtml
End Sub
'检查是否磁盘路径,返回磁盘路径,可接收数组
Private Function CheckTruePath( obj)
If IsArray(obj) Then
Dim i
For i=0 To UBound(obj)
If InStr(obj(i),":")<1 Then
obj(i) = Server.MapPath(obj(i))
End If
Next
CheckTruePath = obj
Else
obj = obj&""
If InStr(obj,":")>0 Then
CheckTruePath = obj
Else
If obj<>"" Then CheckTruePath = Server.MapPath(obj)
End If
End If
End Function
'编译文件
Public Sub Compile(File)
'读取文件内容
strHtml = ReadFile(File)
If strHtml="" Then
Exit Sub
End If
'包含文件
strHtml = Include(strHtml,File)
'去除页面指令
strHtml = RegReplace("<%@[^>]+%\>",strHtml,"")
Dim arrHtml, i, j, k, l
i = InStr(strHtml,"<%")
If i>0 Then
'存在ASP标签，则逐个解析
ReDim arrHtml(0)
j = 0
k = 1
Do Until i<1
l = InStr(i+1,strHtml,"%\>")
If l<1 Then Err.Raise 7,"ASP语法错误，不正确的闭合标签"
ReDim Preserve arrHtml(j+1)
arrHtml(j) = FuncStr &" = "& FuncStr &" &"""&EscapeHtml(Mid(strHtml,k,i-k))&""""
arrHtml(j+1)=Mid(strHtml,i+2,l-i-2)
If Left(arrHtml(j+1),1)="=" Then
arrHtml(j+1) = FuncStr &" = "& FuncStr &" &"& EscapeAsp(Mid(arrHtml(j+1),2))
Else
arrHtml(j+1) = EscapeAsp(arrHtml(j+1))
End If
j = j + 2
k = l + 2
i = InStr(l+1,strHtml,"<%")
Loop
'最后的html内容
ReDim Preserve arrHtml(j)
arrHtml(j) = FuncStr &" = "& FuncStr &" &"""&EscapeHtml(Mid(strHtml,l+2))&""""
strHtml = Join(arrHtml,vbCrLf)
'过滤类
strHtml = FilterClass(strHtml)
'过滤Sub
strHtml = FilterSub(strHtml)
'过滤Function
strHtml = FilterFunction(strHtml)
'执行预包含文件
PrePare
'Response.Write "Function "& FuncStr &"(Param)" & vbCrLf & strHtml & vbCrLf &"End Function"
ＥxecuteGlobal "Function "& FuncStr &"(Param)" & vbCrLf & strHtml & vbCrLf &"End Function"
strHtml = Eval(FuncStr&"(Params)")
End If
End Sub
'清理处理后的内容
Sub Clear
Dim i
strHtml = xTrim(strHtml,Chr(32)&Chr(9)&Chr(10)&Chr(13))
'清理多余的空格
i = InStr(strHtml,Chr(32) & Chr(32))
While i>0
strHtml = Replace(strHtml,Chr(32) & Chr(32),Chr(32))
i = InStr(strHtml,Chr(32) & Chr(32))
Wend
'清理多余的空行
i = InStr(strHtml,vbCrLf & vbCrLf)
While i>0
strHtml = Replace(strHtml,vbCrLf & vbCrLf,vbCrLf)
i = InStr(strHtml,vbCrLf & vbCrLf)
Wend
End Sub
Private Function Require(File)
Dim html, absPath
html = ReadFile(File)
absPath = Mid(File,Len(Server.MapPath("/")))
html = Include(html,absPath)
Dim arrHtml, i, j, k, l
i = InStr(html,"<%")
If i>0 Then
'存在ASP标签,则逐个解析,否则忽略该文件
ReDim arrHtml(0)
j = 0
k = 1
Do Until i<1
l = InStr(i+1,html,"%\>")
If l<1 Then Err.Raise 7,"ASP语法错误，不正确的闭合标签"
ReDim Preserve arrHtml(j+1)
arrHtml(j) = "" '忽略所有非asp内容
arrHtml(j+1)=Mid(html,i+2,l-i-2)
j = j + 2
k = l + 2
i = InStr(l+1,html,"<%")
Loop
ＥxecuteGlobal Join(arrHtml,vbCrLf)
End If
End Function
Private Function EscapeHtml( html)
If InStr(html,"""")>0 Then html = Replace(html,"""","""""")
If InStr(html,vbCrLf)>0 Then html = Replace(html,vbCrLf,"""& vbCrLf &""")
If InStr(html,Chr(10))>0 Then html = Replace(html,Chr(10),"")
If InStr(html,Chr(13))>0 Then html = Replace(html,Chr(13),"")
'If InStr(html,"&""""&")>0 Then html = Replace(html,"&""""&","&")
EscapeHtml = Replace(html,Chr(0),"")
End Function
Private Function EscapeAsp( html)
Dim i
For i=0 To UBound(OutFun)
If InStr(1,html,OutFun(i),1)>0 Then
html = RegReplace("\b"& OutFun(i) &"\b",html,FuncStr &" = "& FuncStr &" &")
End If
Next
If InStr(1,html,"Request.QueryString(",1)>0 Then
html = RegReplace("\bRequest\.QueryString\(",html,"Param(")
End If
EscapeAsp = html
End Function
'包含入文件
Private Function Include(html,ByVal path)
Dim Matches,Match,iHtml, iPath, oHtml, lastIndex
Set Matches=REObject("<!--\s*#include\s+(file|virtual)=""([^*?<>=:""|]+)""\s*-->","gi").Ｅxecute(html)
If Matches.Count>0 Then
lastIndex = 1
For Each Match In Matches
oHtml = oHtml & Mid(html,lastIndex,Match.FirstIndex+1-lastIndex)
If StrComp(Match.SubMatches(0),"file",1)=0 Then
iPath = getDir(path) & Match.SubMatches(1)
ElseIf StrComp(Match.SubMatches(0),"virtual",1)=0 Then
iPath = Match.SubMatches(1)
Else
iPath = ""
End If
If CheckNeedInclude(iPath) Then
iHtml = ReadFile(iPath)
iHtml = Include(iHtml,iPath)
oHtml = oHtml & iHtml
End If
lastIndex = Match.FirstIndex+Match.Length+1
Next
oHtml = oHtml & Mid(html, lastIndex)
Include = oHtml
Else
Include = html
End If
End Function
'检查是否需要包含
Private Function CheckNeedInclude(ByVal path)
CheckNeedInclude = True
If path="" Then CheckNeedInclude = False:Exit Function
path = CheckTruePath(path)
Dim i
'先检查预包含文件
If IsArray(Includes) Then
For i=0 To UBound(Includes)
If StrComp(Includes(i),path,1)=0 Then
CheckNeedInclude = False
Exit Function
End If
Next
End If
'再检查忽略含文件
If IsArray(Ignores) Then
For i=0 To UBound(Ignores)
If StrComp(Ignores(i),path,1)=0 Then
CheckNeedInclude = False
Exit Function
End If
Next
End If
End Function
Private Function FilterClass( html)
Dim Matches,Match,ClassName,oHtml,LastIndex
Set Matches=REObject("\bClass\s+([\w\d\_]+)\b[\s\S]+?\bEnd\s+Class\b","ig").Ｅxecute(html)
If Matches.Count>0 Then
LastIndex = 1
For Each Match In Matches
oHtml = oHtml & Mid(html,LastIndex,Match.FirstIndex+1-LastIndex)
ClassName = Match.SubMatches(0)
If Classes.Exists(ClassName)=False Then
'直接执行类代码，没有处理类内部的属性，函数等功能的输出，尽量事先处理好
ＥxecuteGlobal Match.Value
Classes.Add ClassName,1
End If
LastIndex = Match.FirstIndex+Match.Length+1
Next
oHtml = oHtml & Mid(html, lastIndex)
FilterClass = oHtml
Else
FilterClass = html
End If
End Function
Private Function FilterSub( html)
Dim Matches,Match,SubName,SubStr,oHtml,LastIndex
Set Matches=REObject("\bSub\s+([\w\d\_]+)\b[\s\S]+?\bEnd\s+Sub\b","ig").Ｅxecute(html)
If Matches.Count>0 Then
LastIndex = 1
For Each Match In Matches
oHtml = oHtml & Mid(html,LastIndex,Match.FirstIndex+1-LastIndex)
SubName = Match.SubMatches(0)
SubStr = Match.Value
'这里替换没有排除字符串内部的关键字
SubStr = RegReplace("\bSub\b",SubStr,"Function") '将Sub替换成Function
ＥxecuteGlobal RegReplace("\b"& FuncStr &"\b",SubStr,SubName)
LastIndex = Match.FirstIndex+Match.Length+1
Next
oHtml = oHtml & Mid(html, lastIndex)
FilterSub = oHtml
Else
FilterSub = html
End If
End Function
Private Function FilterFunction( html)
Dim Matches,Match,FunctionName,FunctionStr,oHtml,LastIndex
Set Matches=REObject("\bFunction\s+([\w\d\_]+)\b[\s\S]+?\bEnd\s+Function\b","ig").Ｅxecute(html)
If Matches.Count>0 Then
LastIndex = 1
For Each Match In Matches
oHtml = oHtml & Mid(html,LastIndex,Match.FirstIndex+1-LastIndex)
FunctionName = Match.SubMatches(0)
FunctionStr = Match.Value
'这里替换没有排除字符串内部的关键字,函数名起特殊一点一般可以避免
ＥxecuteGlobal RegReplace("\b"& FuncStr &"\b",FunctionStr,FunctionName)
LastIndex = Match.FirstIndex+Match.Length+1
Next
oHtml = oHtml & Mid(html, lastIndex)
FilterFunction = oHtml
Else
FilterFunction = html
End If
End Function
End Class
这里是我用到的版本的原代码，下面这个压缩包里与这个代码有点差别，就是将类中用到的几个常用函数也封装进来了，方便大家测试，另外还有一个里面用到的xDictionary类
注：改善后的新版地址：解析原生ASP代码的模板引擎(完善版)
豫公网安备 41112102000155号