VBS、ASP代码语法加亮显示的类

代码如下:

<%
Class cBuffer
Private objFSO, objFile, objDict
Private m_strPathToFile, m_TableBGColor, m_StartTime
Private m_EndTime, m_LineCount, m_intKeyMin, m_intKeyMax
Private m_CodeColor, m_CommentColor, m_StringColor, m_TabSpaces

Private Sub Class_Initialize()
TableBGColor = "white"
CodeColor = "Blue"
CommentColor = "Green"
StringColor = "Gray"
TabSpaces = " "
PathToFile = ""

m_StartTime = 0
m_EndTime = 0
m_LineCount = 0

KeyMin = 2
KeyMax = 8

Set objDict = server.CreateObject("Scripting.Dictionary")
objDict.CompareMode = 1

CreateKeywords

Set objFSO = server.CreateObject("Scripting.FileSystemObject")
End Sub

Private Sub Class_Terminate()
Set objDict = Nothing
Set objFSO = Nothing
End Sub

Public Property Let CodeColor(inColor)
m_CodeColor = "<font color=" & inColor & "><Strong>"
End Property
Private Property Get CodeColor()
CodeColor = m_CodeColor
End Property

Public Property Let CommentColor(inColor)
m_CommentColor = "<font color=" & inColor & ">"
End Property
Private Property Get CommentColor()
CommentColor = m_CommentColor
End Property

Public Property Let StringColor(inColor)
m_StringColor = "<font color=" & inColor & ">"
End Property
Private Property Get StringColor()
StringColor = m_StringColor
End Property

Public Property Let TabSpaces(inSpaces)
m_TabSpaces = inSpaces
End Property
Private Property Get TabSpaces()
TabSpaces = m_TabSpaces
End Property

Public Property Let TableBGColor(inColor)
m_TableBGColor = inColor
End Property

Private Property Get TableBGColor()
TableBGColor = m_TableBGColor
End Property

Public Property Get ProcessingTime()
ProcessingTime = Second(m_EndTime - m_StartTime)
End Property

Public Property Get LineCount()
LineCount = m_LineCount
End Property

Public Property Get PathToFile()
PathToFile = m_strPathToFile
End Property
Public Property Let PathToFile(inPath)
m_strPathToFile = inPath
End Property

Private Property Let KeyMin(inMin)
m_intKeyMin = inMin
End Property
Private Property Get KeyMin()
KeyMin = m_intKeyMin
End Property
Private Property Let KeyMax(inMax)
m_intKeyMax = inMax
End Property
Private Property Get KeyMax()
KeyMax = m_intKeyMax
End Property

Private Sub CreateKeywords()
objDict.Add "abs", "Abs"
objDict.Add "and", "And"
objDict.Add "array", "Array"
objDict.Add "call", "Call"
objDict.Add "cbool", "CBool"
objDict.Add "cbyte", "CByte"
objDict.Add "ccur", "CCur"
objDict.Add "cdate", "CDate"
objDict.Add "cdbl", "CDbl"
objDict.Add "cint", "CInt"
objDict.Add "class", "Class"
objDict.Add "clng", "CLng"
objDict.Add "const", "Const"
objDict.Add "csng", "CSng"
objDict.Add "cstr", "CStr"
objDict.Add "date", "Date"
objDict.Add "dim", "Dim"
objDict.Add "do", "Do"
objDict.Add "loop", "Loop"
objDict.Add "empty", "Empty"
objDict.Add "eqv", "Eqv"
objDict.Add "erase", "Erase"
objDict.Add "exit", "Exit"
objDict.Add "false", "False"
objDict.Add "fix", "Fix"
objDict.Add "for", "For"
objDict.Add "next", "Next"
objDict.Add "each", "Each"
objDict.Add "function", "Function"
objDict.Add "global", "Global"
objDict.Add "if", "If"
objDict.Add "then", "Then"
objDict.Add "else", "Else"
objDict.Add "elseif", "ElseIf"
objDict.Add "imp", "Imp"
objDict.Add "int", "Int"
objDict.Add "is", "Is"
objDict.Add "lbound", "LBound"
objDict.Add "len", "Len"
objDict.Add "mod", "Mod"
objDict.Add "new", "New"
objDict.Add "not", "Not"
objDict.Add "nothing", "Nothing"
objDict.Add "null", "Null"
objDict.Add "on", "On"
objDict.Add "error", "Error"
objDict.Add "resume", "Resume"
objDict.Add "option", "Option"
objDict.Add "explicit", "Explicit"
objDict.Add "or", "Or"
objDict.Add "private", "Private"
objDict.Add "property", "Property"
objDict.Add "get", "Get"
objDict.Add "let", "Let"
objDict.Add "set", "Set"
objDict.Add "public", "Public"
objDict.Add "redim", "Redim"
objDict.Add "select", "Select"
objDict.Add "case", "Case"
objDict.Add "end", "End"
objDict.Add "sgn", "Sgn"
objDict.Add "string", "String"
objDict.Add "sub", "Sub"
objDict.Add "true", "True"
objDict.Add "ubound", "UBound"
objDict.Add "while", "While"
objDict.Add "wend", "Wend"
objDict.Add "with", "With"
objDict.Add "xor", "Xor"
End Sub

Private Function Min(x, y)
Dim tempMin
If x < y Then tempMin = x Else tempMin = y
Min = tempMin
End Function

Private Function Max(x, y)
Dim tempMax
If x > y Then tempMax = x Else tempMax = y
Max = tempMax
End Function

Public Sub AddKeyword(inKeyword, inToken)
KeyMin = Min(Len(inKeyword), KeyMin)
KeyMax = Max(Len(inKeyword), KeyMax)

objDict.Add LCase(inKeyword), inToken
End Sub

Public Sub ParseFile(blnOutputHTML)
Dim m_strReadLine, tempString, blnInScriptBlock, blnGoodExtension, i
Dim blnEmptyLine

m_LineCount = 0

If Len(PathToFile) = 0 Then
Err.Raise 5, "cBuffer: PathToFile Length Zero"
Exit Sub
End If

Select Case LCase(Right(PathToFile, 3))
Case "asp", "inc"
blnGoodExtension = True
Case Else
blnGoodExtension = False
End Select

If Not blnGoodExtension Then
Err.Raise 5, "cBuffer: File extension not asp or inc"
Exit Sub
End If

Set objFile = objFSO.OpenTextFile(server.MapPath(PathToFile))

Response.Write "<table nowrap bgcolor=" & TableBGColor & " cellpadding=0 cellspacing=0>"
Response.Write "<tr><td><PRE>"

m_StartTime = Time()

Do While Not objFile.AtEndOfStream
m_strReadLine = objFile.ReadLine

blnEmptyLine = False
If Len(m_strReadLine) = 0 Then
blnEmptyLine = True
End If

m_strReadLine = Replace(m_strReadLine, vbTab, TabSpaces)
m_LineCount = m_LineCount + 1
tempString = LTrim(m_strReadLine)

' Check for the top script line that set's the default script language
' for the page.
If left( tempString, 3 ) = Chr(60) & "%@" And right(tempString, 2) = "%" & Chr(62) Then
Response.Write "<table><tr bgcolor=yellow><td>"
Response.Write server.HTMLEncode(m_strReadLine)
Response.Write "</td></tr></table>"
blnInScriptBlock = False
' Check for an opening script tag
ElseIf Left( tempString, 2) = Chr(60) & "%" Then
' Check for a closing script tag on the same line
If right( RTrim(tempString), 2 ) = "%" & Chr(62) Then
Response.Write "<table><tr><td bgcolor=yellow><%</td>"
Response.Write "<td>"
Response.Write CharacterParse(mid(m_strReadLine, 3, Len(m_strReadLine) - 4))
Response.Write "</td>"
Response.Write "<td bgcolor=yellow>%gt;</td></tr></table>"
blnInScriptBlock = False
Else
Response.Write "<table><tr bgcolor=yellow><td><%</td></tr></table>"
' We've got an opening script tag so set the flag to true so
' that we know to start parsing the lines for keywords/comments
blnInScriptBlock = True
End If
Else
If blnInScriptBlock Then
If blnEmptyLine Then
Response.Write vbCrLf
Else
If right(tempString, 2) = "%" & Chr(62) Then
Response.Write "<table><tr bgcolor=yellow><td>%></td></tr></table>"
blnInScriptBlock = False
Else
Response.Write CharacterParse(m_strReadLine) & vbCrLf
End If
End If
Else
If blnOutputHTML Then
If blnEmptyLine Then
Response.Write vbCrLf
Else
Response.Write server.HTMLEncode(m_strReadLine) & vbCrLf
End If
End If
End If
End If
Loop

' Grab the time at the completion of processing
m_EndTime = Time()

' Close the outside table
Response.Write "</PRE></td></tr></table>"

' Close the file and destroy the file object
objFile.close
Set objFile = Nothing
End Sub

' This function parses a line character by character
Private Function CharacterParse(inLine)
Dim charBuffer, tempChar, i, outputString
Dim insideString, workString, holdChar

insideString = False
outputString = ""

For i = 1 to Len(inLine)
tempChar = mid(inLine, i, 1)
Select Case tempChar
Case " "
If Not insideString Then
charBuffer = charBuffer & " "
If charBuffer <>" " Then
If left(charBuffer, 1) = " " Then outputString = outputString & " "

' Check for a 'rem' style comment marker
If LCase(Trim(charBuffer)) = "rem" Then
outputString = outputString & CommentColor
outputString = outputString & "REM"
workString = mid( inLine, i, Len(inLine))
workString = replace(workString, "<", "&lt;")
workString = replace(workString, ">", "&gt;")
outputString = outputString & workString & "</font>"
charBuffer = ""
Exit For
End If

outputString = outputString & FindReplace(Trim(charBuffer))
If right(charBuffer, 1) = " " Then outputString = outputString & " "
charBuffer = ""
End If
Else
outputString = outputString & " "
End If
Case "("
If left(charBuffer, 1) = " " Then
outputString = outputString & " "
End If
outputString = outputString & FindReplace(Trim(charBuffer)) & "("
charBuffer = ""
Case Chr(60)
outputString = outputString & "<"
Case Chr(62)
outputString = outputString & ">"
Case Chr(34)
' catch quote chars and flip a boolean variable to denote that
' whether or not we're "inside" a quoted string
insideString = Not insideString
If insideString Then
outputString = outputString & StringColor
outputString = outputString & "&quot;"
Else
outputString = outputString & """"
outputString = outputString & "</font>"
End If
Case "'"
' Catch comments and output the rest of the line
' as a comment IF we're not inside a string.
If Not insideString Then
outputString = outputString & CommentColor
workString = mid( inLine, i, Len(inLine))
workString = replace(workString, "<", "&lt;")
workString = replace(workString, ">", "&gt;")
outputString = outputString & workString
outputString = outputString & "</font>"
Exit For
Else
outputString = outputString & "'"
End If
Case Else
' We've dealt with special case characters so now
' we'll begin adding characters to our outputString
' or charBuffer depending on the state of the insideString
' boolean variable
If insideString Then
outputString = outputString & tempChar
Else
charBuffer = charBuffer & tempChar
End If
End Select
Next

' Deal with the last part of the string in the character buffer
If Left(charBuffer, 1) = " " Then
outputString = outputString & " "
End If
' Check for closing parentheses at the end of a string
If right(charBuffer, 1) = ")" Then
charBuffer = Left(charBuffer, Len(charBuffer) - 1)
CharacterParse = outputString & FindReplace(Trim(charBuffer)) & ")"
Exit Function
End If

CharacterParse = outputString & FindReplace(Trim(charBuffer))
End Function

' return true or false if a passed in number is between KeyMin and KeyMax
Private Function InRange(inLen)
If inLen >= KeyMin And inLen <= KeyMax Then
InRange = True
Exit Function
End If
InRange = False
End Function

' Evaluate the passed in string and see if it's a keyword in the
' dictionary. If it is we will add html formatting to the string
' and return it to the caller. Otherwise just return the same
' string as was passed in.
Private Function FindReplace(inToken)
' Check the length to make sure it's within the range of KeyMin and KeyMax
If InRange(Len(inToken)) Then
If objDict.Exists(inToken) Then
FindReplace = CodeColor & objDict.Item(inToken) & "</Strong></Font>"
Exit Function
End If
End If
' Keyword is either too short or too long or doesn't exist in the
' dictionary so we'll just return what was passed in to the function 
FindReplace = inToken
End Function

End Class
%>

<!--#include file="token.asp"-->
<% ' *************************************************************************
' This is all test/example code showing the calling syntax of the 
' cBuffer class ... the interface to the cBuffer object is quite simple.
'
' Use it for reference ... delete it ... whatever.
' *************************************************************************

REM This is a rem type comment just for testing purposes!

' This variable will hold an instance of the cBuffer class
Dim objBuffer

' Set up the error handling
On Error Resume Next

' create the instance of the cBuffer class
Set objBuffer = New cBuffer

' Set the PathToFile property of the cBuffer class
'
' Just for kicks we'll use the asp file that we created
' in the last installment of this article series for testing purposes
objBuffer.PathToFile = "../081899/random.asp" '这是文件名啦。

' Here's an example of how to add a new keyword to the keyword array
' You could add a list of your own function names, variables or whatever...cool!
' NOTE: You can add different HTML formatting if you like, the <strong>
' attribute will applied to all keywords ... this is likely to change
' in the near future.
'
'objBuffer.AddKeyword "response.write", "<font color=Red>Response.Write</font>"

' Here are examples of changing the table background color, code color, 
' comment color, string color and tab space properties
'
'objBuffer.TableBGColor = "LightGrey" ' or
'objBuffer.TableBGColor = "#ffffdd" ' simple right?
'objBuffer.CodeColor = "Red"
'objBuffer.CommentColor = "Orange"
'objBuffer.StringColor = "Purple"
'objBuffer.TabSpaces = " "

' Call the ParseFile method of the cBuffer class, pass it true if you want the
' HTML contained in the page output or false if you don't
objBuffer.ParseFile False '注意:显示代码的response.write已经在class中。这里调用方法就可以了。

' Check for errors that may have been raised and write them out
If Err.number <> 0 Then
Response.Write Err.number & ":" & Err.description & ":" & Err.source & "<br>"
End If

' Output the processing time and number of lines processed by the script
Response.Write "<strong>Processing Time:</strong> " & objBuffer.ProcessingTime & " seconds<br>"
Response.Write "<strong>Lines Processed:</strong> " & objBuffer.LineCount & "<br>"

' Destroy the instance of our cBuffer class
Set objBuffer = Nothing
%>

(0)

相关推荐

  • VBS、ASP代码语法加亮显示的类

    复制代码 代码如下: <% Class cBuffer Private objFSO, objFile, objDict Private m_strPathToFile, m_TableBGColor, m_StartTime Private m_EndTime, m_LineCount, m_intKeyMin, m_intKeyMax Private m_CodeColor, m_CommentColor, m_StringColor, m_TabSpaces Private Sub Cla

  • 雷客图ASP站长安全助手vbs测试版代码

    雷客图ASP站长安全助手是一个基于ASP的帮助站长维护网站安全的程序.这个版本(vbs测试版)主要用于服务器本地运行以查找ASP木马.此版本为测试版,希望大家提供反馈意见,谢谢.另,正式版将整合到雷客图ASP站长安全助手的下个版本. 使用说明: 在命令提示符下: #用法: CScript scan.vbs [扫描路径] [结果HTM文件路径] #例子: CScript scan.vbs d:\Web f:\my\report.html 复制代码 代码如下: '------------------

  • 雷客图 站长安全助手 vbs版代码(asp 木马查找)

    均在命令行下使用 AntiIframe.vbs #该脚本是批量挂马程序的逆向,用于批量清除被添加到文件中的恶意代码.记事本打开文件可以修改Pattern参数指定要处理的文件名,文件名之间用|隔开(也支持vbs正则表达式).由于要修改文件,请谨慎的使用(最好先备份文件) #用法: CScript AntiIframe.vbs [处理的路径] [包含清除内容的文件] #例子: CScript AntiIframe.vbs d:\Web d:\lake2.txt -------------------

  • asp.net 读取并显示excel数据的实现代码

    我们的ASP页面将在远程服务器上,来读取我们的桌面Excel文件.首先,我们必须把它上传到远程服务器,然后retrive数据.因此,我们首先设计一个表格,上传到服务器.我们必须从文件retrive数据,再一次,所以我们将重新命名Excel,然后上传. 复制代码 代码如下: <%@ Page Language="VB" AutoEventWireup="false" CodeFile="Default.aspx.vb" Inherits=&q

  • 在ASP.NET使用JavaScript显示信息提示窗口实现原理及代码

    在ASP.NET使用JavaScript显示信息窗口,你可下从Insus.NET的博客,下载一个DLL,放在站点的BIN目录.下载地址创建一个aspx页面,然后在.aspx.cs的做几个动作,一是引用命名空间,实例化对象. 然后在Page_load事件写javascript脚本: 复制代码 代码如下: protected void Page_Load(object sender, EventArgs e) { string message = "Welcome, Insus.NET!"

  • asp,VBscript语法错误,史上最全最详细最精确第1/3页

    ASP错误总结  -------------------------------------------------------------------------------- Microsoft VBscript语法错误(0x800A03E9)-->内存不足 Microsoft VBscript语法错误(0x800A03EA)-->语法错误 Microsoft VBscript语法错误(0x800A03EB)-->缺少 ':' Microsoft VBscript语法错误(0x800

  • ASP怎么谈到应用到类的?

    先摘录天极网扬老师一篇文章中的一段: 面向对象的程序设计 随着程序的设计的复杂性增加,结构化程序设计方法又不够用了.不够用的根本原因是"代码重用"的时候不方便.面向对象的方法诞生了,它通过继承来实现比较完善的代码重用功能.很多学生在应聘工作,面试的时候,常被问及一个问题"你来谈谈什么是面向对象的程序设计",学生无言,回来问我,这个问题应该怎么回答.我告诉他,你只要说一句话就够了"面向对象程序设计是对数据的封装:范式(模板)的程序设计是对算法的封装.&quo

  • 关于Asp代码与页面的分离模板技术第1/3页

    在使用ASP制作一个站点的时候,常常会出现一个ASP文件中,程序代码和HTML代码混合的情况.这样子做有许多缺点: 1.编程时就要对页面布局进行设计和编排,造成代码混乱难懂,不规范; 2.当需要改变页面外观时,你不仅要改变HTML部份,也需要改变ASP代码,不易维护. 那么,要如何才能避免这些麻烦呢? 答案就是使用模板文件,将ASP代码和HTML页面分开,一切问题就都解决了.使用模板有以下好处: 1.在很短的时间内可以替换整个站点的外观; 2.使程序员可以抽象编程,而无须接触HTML代码; 3.

  • 使用模板实现ASP代码与页面分离

    每个进行过较大型的ASP-Web应用程序设计的开发人员大概都有如下的经历:ASP代码与页面HTML混淆难分,业务逻辑与显示方式绞合,使得代码难以理解.难以修改:程序编写必须在美工之后,成为项目瓶颈:整合的程序代码和HTML静态页面时,花费大量的时间才能得到理想的效果,兼作了美工.的确,用脚本语言开发Web应用不容易将数据的处理和数据的显示分开,但在多人合作的情况下,如果无法将数据和显示分开,将大大影响开发的效率,专业分工的发挥. 其它的脚本语言,如JSP.PHP都有自己的解决方案,ASP的后一代

  • 2016年最热门的15 款代码语法高亮工具,美化你的代码

    前言: 代码高亮很有用,特别是在需要在网站或者blog中显示自己编写的代码的时候,或者给其他人查看或调试语法错误的时候.我们可以将代码高亮,以便阅读者可以十分方便的读取代码块,增加用户阅读代码的良好体验. 语法高亮是文本编辑器用来显示文本的,特别是源代码,根据不同的类别来用不同的颜色和字体显示.这个功能有助于编写结构化的语言,比如编程语言,标记语言,这些语言的语法错误显示是有区别的.语法高亮并不会影响文本自身的意义,而且能很好的符合人们的阅读习惯. 目前,有很多免费而且有用的代码高亮脚本.这些脚

随机推荐