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>

上一个：asp数组使用(2)
下一个：asp下载防盗链代码