idea中html出现VBscript,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 = ""

End Property

Private Property Get CodeColor()

CodeColor = m_CodeColor

End Property

Public Property Let CommentColor(inColor)

m_CommentColor = ""

End Property

Private Property Get CommentColor()

CommentColor = m_CommentColor

End Property

Public Property Let StringColor(inColor)

m_StringColor = ""

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 

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 "

Response.Write "

"

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 "

" Response.Write server.HTMLEncode(m_strReadLine) Response.Write "

"

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 "

" Response.Write "

" Response.Write CharacterParse(mid(m_strReadLine, 3, Len(m_strReadLine) - 4)) Response.Write "

Response.Write "

%gt;"

blnInScriptBlock = False

Else

Response.Write "

"

' 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 "

%>

"

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 "

"

' 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, "

workString = replace(workString, ">", "＆ｇｔ；")

outputString = outputString & workString & ""

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 & "＆ｑｕｏｔ；"

Else

outputString = outputString & """"

outputString = outputString & ""

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, "

workString = replace(workString, ">", "＆ｇｔ；")

outputString = outputString & workString

outputString = outputString & ""

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) & ""

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

%>

' 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 

' attribute will applied to all keywords ... this is likely to change

' in the near future.

'

'objBuffer.AddKeyword "response.write", "Response.Write"

' 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 & "
"

End If

' Output the processing time and number of lines processed by the script

Response.Write "Processing Time: " & objBuffer.ProcessingTime & " seconds
"

Response.Write "Lines Processed: " & objBuffer.LineCount & "
"

' Destroy the instance of our cBuffer class

Set objBuffer = Nothing

%>