ASP編程中常用代碼語法加亮顯示的類

在一些ASP編程類網站上經常見到這樣的效果，一些頁面上的ASP代碼，顯示在頁面上的效果如同顯示在dreamweare，看起來非常符合程序開發人員的習慣。下面就是這樣的代碼類 vIEw source print? 001 <% 002 Class cBuffer 003 Private objFSO, objFile, objDict 004 Private m_strPathToFile, m_TableBGColor, m_StartTime 005 Private m_EndTime, m_LineCount, m_intKeyMin, m_intKeyMax 006 Private m_CodeColor, m_CommentColor, m_StringColor, m_TabSpaces 007   008 Private Sub Class_Initialize() 009 TableBGColor = "white" 010 CodeColor = "Blue" 011 CommentColor = "Green" 012 StringColor = "Gray" 013 TabSpaces = " " 014 PathToFile = "" 015   016 m_StartTime = 0 017 m_EndTime = 0 018 m_LineCount = 0 019   020 KeyMin = 2 021 KeyMax = 8 022   023 Set objDict = server.CreateObject("Scripting.Dictionary") 024 objDict.CompareMode = 1 025   026 CreateKeyWords 027   028 Set objFSO = server.CreateObject("Scripting.FileSystemObject") 029 End Sub 030   031 Private Sub Class_Terminate() 032 Set objDict = Nothing 033 Set objFSO = Nothing 034 End Sub 035   036   037 Public Property Let CodeColor(inColor) 038 m_CodeColor = "<font color=" & inColor & "><Strong>" 039 End Property 040 Private Property Get CodeColor() 041 CodeColor = m_CodeColor 042 End Property 043   044 Public Property Let CommentColor(inColor) 045 m_CommentColor = "<font color=" & inColor & ">" 046 End Property 047 Private Property Get CommentColor() 048 CommentColor = m_CommentColor 049 End Property 050   051 Public Property Let StringColor(inColor) 052 m_StringColor = "<font color=" & inColor & ">" 053 End Property 054 Private Property Get StringColor() 055 StringColor = m_StringColor 056 End Property 057   058 Public Property Let TabSpaces(inSpaces) 059 m_TabSpaces = inSpaces 060 End Property 061 Private Property Get TabSpaces() 062 TabSpaces = m_TabSpaces 063 End Property 064   065 Public Property Let TableBGColor(inColor) 066 m_TableBGColor = inColor 067 End Property 068   069 Private Property Get TableBGColor() 070 TableBGColor = m_TableBGColor 071 End Property 072   073 Public Property Get ProcessingTime() 074 ProcessingTime = Second(m_EndTime - m_StartTime) 075 End Property 076   077 Public Property Get LineCount() 078 LineCount = m_LineCount 079 End Property 080   081 Public Property Get PathToFile() 082 PathToFile = m_strPathToFile 083 End Property 084 Public Property Let PathToFile(inPath) 085 m_strPathToFile = inPath 086 End Property 087   088 Private Property Let KeyMin(inMin) 089 m_intKeyMin = inMin 090 End Property 091 Private Property Get KeyMin() 092 KeyMin = m_intKeyMin 093 End Property 094 Private Property Let KeyMax(inMax) 095 m_intKeyMax = inMax 096 End Property 097 Private Property Get KeyMax() 098 KeyMax = m_intKeyMax 099 End Property 100   101 Private Sub CreateKeyWords() 102 objDict.Add "abs", "Abs" 103 objDict.Add "and", "And" 104 objDict.Add "array", "Array" 105 objDict.Add "call", "Call" 106 objDict.Add "cbool", "CBool" 107 objDict.Add "cbyte", "CByte" 108 objDict.Add "ccur", "CCur" 109 objDict.Add "cdate", "CDate" 110 objDict.Add "cdbl", "CDbl" 111 objDict.Add "cint", "CInt" 112 objDict.Add "class", "Class" 113 objDict.Add "clng", "CLng" 114 objDict.Add "const", "Const" 115 objDict.Add "csng", "CSng" 116 objDict.Add "cstr", "CStr" 117 objDict.Add "date", "Date" 118 objDict.Add "dim", "Dim" 119 objDict.Add "do", "Do" 120 objDict.Add "loop", "Loop" 121 objDict.Add "empty", "Empty" 122 objDict.Add "eqv", "Eqv" 123 objDict.Add "erase", "Erase" 124 objDict.Add "exit", "Exit" 125 objDict.Add "false", "False" 126 objDict.Add "fix", "Fix" 127 objDict.Add "for", "For" 128 objDict.Add "next", "Next" 129 objDict.Add "each", "Each" 130 objDict.Add "function", "Function" 131 objDict.Add "global", "Global" 132 objDict.Add "if", "If" 133 objDict.Add "then", "Then" 134 objDict.Add "else", "Else" 135 objDict.Add "elseif", "ElseIf" 136 objDict.Add "imp", "Imp" 137 objDict.Add "int", "Int" 138 objDict.Add "is", "Is" 139 objDict.Add "lbound", "LBound" 140 objDict.Add "len", "Len" 141 objDict.Add "mod", "Mod" 142 objDict.Add "new", "New" 143 objDict.Add "not", "Not" 144 objDict.Add "nothing", "Nothing" 145 objDict.Add "null", "Null" 146 objDict.Add "on", "On" 147 objDict.Add "error", "Error" 148 objDict.Add "resume", "Resume" 149 objDict.Add "option", "Option" 150 objDict.Add "explicit", "Explicit" 151 objDict.Add "or", "Or" 152 objDict.Add "private", "Private" 153 objDict.Add "property", "Property" 154 objDict.Add "get", "Get" 155 objDict.Add "let", "Let" 156 objDict.Add "set", "Set" 157 objDict.Add "public", "Public" 158 objDict.Add "redim", "Redim" 159 objDict.Add "select", "Select" 160 objDict.Add "case", "Case" 161 objDict.Add "end", "End" 162 objDict.Add "sgn", "Sgn" 163 objDict.Add "string", "String" 164 objDict.Add "sub", "Sub" 165 objDict.Add "true", "True" 166 objDict.Add "ubound", "UBound" 167 objDict.Add "while", "While" 168 objDict.Add "wend", "Wend" 169 objDict.Add "with", "With" 170 objDict.Add "xor", "Xor" 171 End Sub 172   173 Private Function Min(x, y) 174 Dim tempMin 175 If x < y Then tempMin = x Else tempMin = y 176 Min = tempMin 177 End Function 178   179 Private Function Max(x, y) 180 Dim tempMax 181 If x > y Then tempMax = x Else tempMax = y 182 Max = tempMax 183 End Function 184   185 Public Sub AddKeyword(inKeyWord, inToken) 186 KeyMin = Min(Len(inKeyWord), KeyMin) 187 KeyMax = Max(Len(inKeyWord), KeyMax) 188   189 objDict.Add LCase(inKeyWord), inToken 190 End Sub 191   192 Public Sub ParseFile(blnOutputHtml) 193 Dim m_strReadLine, tempString, blnInScriptBlock, blnGoodExtension, i 194 Dim blnEmptyLine 195   196 m_LineCount = 0 197   198 If Len(PathToFile) = 0 Then 199 Err.Raise 5, "cBuffer: PathToFile Length Zero" 200 Exit Sub 201 End If 202   203 Select Case LCase(Right(PathToFile, 3)) 204 Case "ASP", "inc" 205 blnGoodExtension = True 206 Case Else 207 blnGoodExtension = False 208 End Select 209   210 If Not blnGoodExtension Then 211 Err.Raise 5, "cBuffer: File extension not ASP or inc" 212 Exit Sub 213 End If 214   215 Set objFile = objFSO.OpenTextFile(server.MapPath(PathToFile)) 216   217 Response.Write "<table nowrap bgcolor=" & TableBGColor & " cellpadding=0 cellspacing=0>" 218 Response.Write "<tr><td><PRE>" 219   220 m_StartTime = Time() 221   222 Do While Not objFile.AtEndOfStream 223 m_strReadLine = objFile.ReadLine 224   225 blnEmptyLine = False 226 If Len(m_strReadLine) = 0 Then 227 blnEmptyLine = True 228 End If 229   230 m_strReadLine = Replace(m_strReadLine, vbTab, TabSpaces) 231 m_LineCount = m_LineCount + 1 232 tempString = LTrim(m_strReadLine) 233   234 ' Check for the top script line that set's the default script language 235 ' for the page. 236 If left( tempString, 3 ) = Chr(60) & "%@" And right(tempString, 2) ="%" & Chr(62) Then 237 Response.Write "<table><tr bgcolor=yellow><td>" 238 Response.Write server.HtmlEncode(m_strReadLine) 239 Response.Write "</td></tr></table>" 240 blnInScriptBlock = False 241 ' Check for an opening script tag 242 ElseIf Left( tempString, 2) = Chr(60) & "%" Then 243 ' Check for a closing script tag on the same line 244 If right( RTrim(tempString), 2 ) = "%" & Chr(62) Then 245 Response.Write "<table><tr><td bgcolor=yellow><%</td>" 246 Response.Write "<td>" 247 Response.Write CharacterParse(mid(m_strReadLine, 3, Len(m_strReadLine) - 4)) 248 Response.Write "</td>" 249 Response.Write "<td bgcolor=yellow>%gt;</td></tr></table>" 250 blnInScriptBlock = False 251 Else 252 Response.Write "<table><tr bgcolor=yellow><td><%</td></tr></table>" 253 ' We've got an opening script tag so set the flag to true so 254 ' that we know to start parsing the lines for keyWords/comments 255 blnInScriptBlock = True 256 End If 257 Else 258 If blnInScriptBlock Then 259 If blnEmptyLine Then 260 Response.Write vbCrLf 261 Else 262 If right(tempString, 2) = "%" & Chr(62) Then 263 Response.Write "<table><tr bgcolor=yellow><td>%></td></tr></table>" 264 blnInScriptBlock = False 265 Else 266 Response.Write CharacterParse(m_strReadLine) & vbCrLf 267 End If 268 End If 269 Else 270 If blnOutputHtml Then 271 If blnEmptyLine Then 272 Response.Write vbCrLf 273 Else 274 Response.Write server.HtmlEncode(m_strReadLine) & vbCrLf 275 End If 276 End If 277 End If 278 End If 279 Loop 280   281 ' Grab the time at the completion of processing 282 m_EndTime = Time() 283   284 ' Close the outside table 285 Response.Write "</PRE></td></tr></table>" 286   287 ' Close the file and destroy the file object 288 objFile.close 289 Set objFile = Nothing 290 End Sub 291   292 ' This function parses a line character by character 293 Private Function CharacterParse(inLine) 294 Dim charBuffer, tempChar, i, outputString 295 Dim insideString, workString, holdChar 296   297 insideString = False 298 outputString = "" 299   300 For i = 1 to Len(inLine) 301 tempChar = mid(inLine, i, 1) 302 Select Case tempChar 303 Case " " 304 If Not insideString Then 305 charBuffer = charBuffer & " " 306 If charBuffer <>" " Then 307 If left(charBuffer, 1) = " " Then outputString = outputString & " " 308   309 ' Check for a 'rem' style comment marker 310 If LCase(Trim(charBuffer)) = "rem" Then 311 outputString = outputString & CommentColor 312 outputString = outputString & "REM" 313 workString = mid( inLine, i, Len(inLine)) 314 workString = replace(workString, "<", "＆ｌｔ；") 315 workString = replace(workString, ">", "＆ｇｔ；") 316 outputString = outputString & workString & "</font>" 317 charBuffer = "" 318 Exit For 319 End If 320   321 outputString = outputString & FindReplace(Trim(charBuffer)) 322 If right(charBuffer, 1) = " " Then outputString = outputString & " " 323 charBuffer = "" 324 End If 325 Else 326 outputString = outputString & " " 327 End If 328 Case "(" 329 If left(charBuffer, 1) = " " Then 330 outputString = outputString & " " 331 End If 332 outputString = outputString & FindReplace(Trim(charBuffer)) & "(" 333 charBuffer = "" 334 Case Chr(60) 335 outputString = outputString & "<" 336 Case Chr(62) 337 outputString = outputString & ">" 338 Case Chr(34) 339 ' catch quote chars and flip a boolean variable to denote that 340 ' whether or not we're "inside" a quoted string 341 insideString = Not insideString 342 If insideString Then 343 outputString = outputString & StringColor 344 outputString = outputString & "＆ｑｕｏｔ；" 345 Else 346 outputString = outputString & """" 347 outputString = outputString & "</font>" 348 End If 349 Case "'" 350 ' Catch comments and output the rest of the line 351 ' as a comment IF we're not inside a string. 352 If Not insideString Then 353 outputString = outputString & CommentColor 354 workString = mid( inLine, i, Len(inLine)) 355 workString = replace(workString, "<", "＆ｌｔ；") 356 workString = replace(workString, ">", "＆ｇｔ；") 357 outputString = outputString & workString 358 outputString = outputString & "</font>" 359 Exit For 360 Else 361 outputString = outputString & "'" 362 End If 363 Case Else 364 ' We've dealt with special case characters so now 365 ' we'll begin adding characters to our outputString 366 ' or charBuffer depending on the state of the insideString 367 ' boolean variable 368 If insideString Then 369 outputString = outputString & tempChar 370 Else 371 charBuffer = charBuffer & tempChar 372 End If 373 End Select 374 Next 375   376 ' Deal with the last part of the string in the character buffer 377 If Left(charBuffer, 1) = " " Then 378 outputString = outputString & " " 379 End If 380 ' Check for closing parentheses at the end of a string 381 If right(charBuffer, 1) = ")" Then 382 charBuffer = Left(charBuffer, Len(charBuffer) - 1) 383 CharacterParse = outputString & FindReplace(Trim(charBuffer)) & ")" 384 Exit Function 385 End If 386   387 CharacterParse = outputString & FindReplace(Trim(charBuffer)) 388 End Function 389   390 ' return true or false if a passed in number is between KeyMin and KeyMax 391 Private Function InRange(inLen) 392 If inLen >= KeyMin And inLen <= KeyMax Then 393 InRange = True 394 Exit Function 395 End If 396 InRange = False 397 End Function 398   399 ' Evaluate the passed in string and see if it's a keyWord in the 400 ' dictionary. If it is we will add Html formatting to the string 401 ' and return it to the caller. Otherwise just return the same 402 ' string as was passed in. 403 Private Function FindReplace(inToken) 404 ' Check the length to make sure it's within the range of KeyMin and KeyMax 405 If InRange(Len(inToken)) Then 406 If objDict.Exists(inToken) Then 407 FindReplace = CodeColor & objDict.Item(inToken) & "</Strong></Font>" 408 Exit Function 409 End If 410 End If 411 ' KeyWord is either too short or too long or doesn't exist in the 412 ' dictionary so we'll just return what was passed in to the function 413 FindReplace = inToken 414 End Function 415   416 End Class 417 %> 418   419   420   421   422   423 <!--#include file="token.ASP"--> 424 <% ' ************************************************************************* 425 ' This is all test/example code showing the calling syntax of the 426 ' cBuffer class ... the interface to the cBuffer object is quite simple. 427 ' 428 ' Use it for reference ... delete it ... whatever. 429 ' ************************************************************************* 430   431 REM This is a rem type comment just for testing purposes! 432   433 ' This variable will hold an instance of the cBuffer class 434 Dim objBuffer 435   436 ' Set up the error handling 437 On Error Resume Next 438   439 ' create the instance of the cBuffer class 440 Set objBuffer = New cBuffer 441   442 ' Set the PathToFile property of the cBuffer class 443 ' 444 ' Just for kicks we'll use the ASP file that we created 445 ' in the last installment of this article serIEs for testing purposes 446 objBuffer.PathToFile = "../081899/random.ASP" '這是文件名啦。 447   448 ' Here's an example of how to add a new keyword to the keyWord array 449 ' You could add a list of your own function names, variables or whatever...cool! 450 ' NOTE: You can add different Html formatting if you like, the <strong> 451 ' attribute will applIEd to all keyWords ... this is likely to change 452 ' in the near future. 453 ' 454 'objBuffer.AddKeyWord "response.write", "<font color=Red>Response.Write</font>" 455   456 ' Here are examples of changing the table background color, code color, 457 ' comment color, string color and tab space propertIEs 458 ' 459 'objBuffer.TableBGColor = "LightGrey" ' or 460 'objBuffer.TableBGColor = "#ffffdd" ' simple right? 461 'objBuffer.CodeColor = "Red" 462 'objBuffer.CommentColor = "Orange" 463 'objBuffer.StringColor = "Purple" 464 'objBuffer.TabSpaces = " " 465   466 ' Call the ParseFile method of the cBuffer class, pass it true if you want the 467 ' Html contained in the page output or false if you don't 468 objBuffer.ParseFile False '注意：顯示代碼的response.write已經在class中。這裡調用方法就可以了。 469   470   471   472 ' Check for errors that may have been raised and write them out 473 If Err.number <> 0 Then 474 Response.Write Err.number & ":" & Err.description & ":" & Err.source &"<br>" 475 End If 476   477 ' Output the processing time and number of lines processed by the script 478 Response.Write "<strong>Processing Time:</strong> " & objBuffer.ProcessingTime & " seconds<br>" 479 Response.Write "<strong>Lines Processed:</strong> " & objBuffer.LineCount & "<br>" 480   481 ' Destroy the instance of our cBuffer class 482 Set objBuffer = Nothing 483 %>