[转贴]用asp处理,VBScript的高量显视类

 1 Class cBuffer   
 2Private objFSO, objFile, objDict   
 3Private m_strPathToFile, m_TableBGColor, m_StartTime   
 4Private m_EndTime, m_LineCount, m_intKeyMin, m_intKeyMax   
 5Private m_CodeColor, m_CommentColor, m_StringColor, m_TabSpaces   
 6  
 7Private Sub Class_Initialize()   
 8TableBGColor = "white"   
 9CodeColor = "Blue"   
10CommentColor = "Green"   
11StringColor = "Gray"   
12TabSpaces = " "   
13PathToFile = ""   
14  
15m_StartTime = 0   
16m_EndTime = 0   
17m_LineCount = 0   
18  
19KeyMin = 2   
20KeyMax = 8   
21  
22Set objDict = server.CreateObject("Scripting.Dictionary")   
23objDict.CompareMode = 1   
24  
25CreateKeywords   
26  
27Set objFSO = server.CreateObject("Scripting.FileSystemObject")   
28End Sub   
29  
30Private Sub Class_Terminate()   
31Set objDict = Nothing   
32Set objFSO = Nothing   
33End Sub   
34  
35  
36Public Property Let CodeColor(inColor)   
37m_CodeColor = "

<font color=" &amp; inColor &amp; "><strong>"
End Property
Private Property Get CodeColor()
CodeColor = m_CodeColor
End Property

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

Public Property Let StringColor(inColor)
m_StringColor = "<font color=" &amp; inColor &amp; ">"
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 &lt; y Then tempMin = x Else tempMin = y
Min = tempMin
End Function

Private Function Max(x, y)
Dim tempMax
If x &gt; 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 bgcolor=" &amp; TableBGColor &amp; " cellpadding="0" cellspacing="0" nowrap="">"
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) &amp; "%@" And right(tempString, 2) = "%" &amp; 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) &amp; "%" Then
' Check for a closing script tag on the same line
If right( RTrim(tempString), 2 ) = "%" &amp; Chr(62) Then
Response.Write "<table><tr><td bgcolor="yellow">&lt;%</td>"
Response.Write "<td>"
Response.Write CharacterParse(mid(m_strReadLine, 3, Len(m_strReadLine) - 4))
Response.Write "</td>"
Response.Write "<td bgcolor="yellow">

  1blnInScriptBlock = False   
  2Else   
  3Response.Write "<table><tr bgcolor="yellow"><td>```
  4&lt;/td&gt;&lt;/tr&gt;&lt;/table&gt;"   
  5' We've got an opening script tag so set the flag to true so   
  6' that we know to start parsing the lines for keywords/comments   
  7blnInScriptBlock = True   
  8End If   
  9Else   
 10If blnInScriptBlock Then   
 11If blnEmptyLine Then   
 12Response.Write vbCrLf   
 13Else   
 14If right(tempString, 2) = "%" &amp;amp; Chr(62) Then   
 15Response.Write "&lt;table&gt;&lt;tr bgcolor="yellow"&gt;&lt;td&gt;
 16```</td></tr></table>"   
 17blnInScriptBlock = False   
 18Else   
 19Response.Write CharacterParse(m_strReadLine) &amp; vbCrLf   
 20End If   
 21End If   
 22Else   
 23If blnOutputHTML Then   
 24If blnEmptyLine Then   
 25Response.Write vbCrLf   
 26Else   
 27Response.Write server.HTMLEncode(m_strReadLine) &amp; vbCrLf   
 28End If   
 29End If   
 30End If   
 31End If   
 32Loop   
 33  
 34' Grab the time at the completion of processing   
 35m_EndTime = Time()   
 36  
 37' Close the outside table   
 38Response.Write "</pre></td></tr></table>"   
 39  
 40' Close the file and destroy the file object   
 41objFile.close   
 42Set objFile = Nothing   
 43End Sub   
 44  
 45' This function parses a line character by character   
 46Private Function CharacterParse(inLine)   
 47Dim charBuffer, tempChar, i, outputString   
 48Dim insideString, workString, holdChar   
 49  
 50insideString = False   
 51outputString = ""   
 52  
 53For i = 1 to Len(inLine)   
 54tempChar = mid(inLine, i, 1)   
 55Select Case tempChar   
 56Case " "   
 57If Not insideString Then   
 58charBuffer = charBuffer &amp; " "   
 59If charBuffer &lt;&gt;" " Then   
 60If left(charBuffer, 1) = " " Then outputString = outputString &amp; " "   
 61  
 62' Check for a 'rem' style comment marker   
 63If LCase(Trim(charBuffer)) = "rem" Then   
 64outputString = outputString &amp; CommentColor   
 65outputString = outputString &amp; "REM"   
 66workString = mid( inLine, i, Len(inLine))   
 67workString = replace(workString, "&lt;", "&lt;")   
 68workString = replace(workString, "&gt;", "&gt;")   
 69outputString = outputString &amp; workString &amp; "</font>"   
 70charBuffer = ""   
 71Exit For   
 72End If   
 73  
 74outputString = outputString &amp; FindReplace(Trim(charBuffer))   
 75If right(charBuffer, 1) = " " Then outputString = outputString &amp; " "   
 76charBuffer = ""   
 77End If   
 78Else   
 79outputString = outputString &amp; " "   
 80End If   
 81Case "("   
 82If left(charBuffer, 1) = " " Then   
 83outputString = outputString &amp; " "   
 84End If   
 85outputString = outputString &amp; FindReplace(Trim(charBuffer)) &amp; "("   
 86charBuffer = ""   
 87Case Chr(60)   
 88outputString = outputString &amp; "&lt;"   
 89Case Chr(62)   
 90outputString = outputString &amp; "&gt;"   
 91Case Chr(34)   
 92' catch quote chars and flip a boolean variable to denote that   
 93' whether or not we're "inside" a quoted string   
 94insideString = Not insideString   
 95If insideString Then   
 96outputString = outputString &amp; StringColor   
 97outputString = outputString &amp; """   
 98Else   
 99outputString = outputString &amp; """"   
100outputString = outputString &amp; "</font>"   
101End If   
102Case "'"   
103' Catch comments and output the rest of the line   
104' as a comment IF we're not inside a string.   
105If Not insideString Then   
106outputString = outputString &amp; CommentColor   
107workString = mid( inLine, i, Len(inLine))   
108workString = replace(workString, "&lt;", "&lt;")   
109workString = replace(workString, "&gt;", "&gt;")   
110outputString = outputString &amp; workString   
111outputString = outputString &amp; "</strong></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) & " "
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
%>

 1 ' *************************************************************************   
 2' This is all test/example code showing the calling syntax of the   
 3' cBuffer class ... the interface to the cBuffer object is quite simple.   
 4'   
 5' Use it for reference ... delete it ... whatever.   
 6' *************************************************************************   
 7  
 8REM This is a rem type comment just for testing purposes!   
 9  
10' This variable will hold an instance of the cBuffer class   
11Dim objBuffer   
12  
13' Set up the error handling   
14On Error Resume Next   
15  
16' create the instance of the cBuffer class   
17Set objBuffer = New cBuffer   
18  
19' Set the PathToFile property of the cBuffer class   
20'   
21' Just for kicks we'll use the asp file that we created   
22' in the last installment of this article series for testing purposes   
23objBuffer.PathToFile = "t.asp" '这是文件名啦。   
24  
25' Here's an example of how to add a new keyword to the keyword array   
26' You could add a list of your own function names, variables or whatever...cool!   
27' 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 = "Blue"
'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 &lt;&gt; 0 Then
Response.Write Err.number &amp; ":" &amp; Err.description &amp; ":" &amp; Err.source &amp; "<br/>"
End If

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

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

Published At
Categories with Web编程
Tagged with
comments powered by Disqus