所属类别：ASP编程

特别推荐：免费发布信息 承包关键词~~抢爆了！^HOT!

[复制此代码]CODE:<%Class cBufferPrivate objFSO, objFile, objDictPrivate m_strPathToFile, m_TableBGColor, m_StartTimePrivate m_EndTime, m_LineCount, m_intKeyMin, m_intKeyMaxPrivate m_CodeColor, m_CommentColor, m_StringColor, m_TabSpacesPrivate Sub Class_Initialize()TableBGColor = "white"CodeColor = "Blue"CommentColor = "Green"StringColor = "Gray"TabSpaces = " "PathToFile = ""m_StartTime = 0m_EndTime = 0m_LineCount = 0KeyMin = 2KeyMax = 8Set objDict = server.CreateObject("Scripting.Dictionary")objDict.CompareMode = 1CreateKeywordsSet objFSO = server.CreateObject("Scripting.FileSystemObject")End SubPrivate Sub Class_Terminate()Set objDict = NothingSet objFSO = NothingEnd SubPublic Property Let CodeColor(inColor)m_CodeColor = ""End PropertyPrivate Property Get CodeColor()CodeColor = m_CodeColorEnd PropertyPublic Property Let CommentColor(inColor)m_CommentColor = ""End PropertyPrivate Property Get CommentColor()CommentColor = m_CommentColorEnd PropertyPublic Property Let StringColor(inColor)m_StringColor = ""End PropertyPrivate Property Get StringColor()StringColor = m_StringColorEnd PropertyPublic Property Let TabSpaces(inSpaces)m_TabSpaces = inSpacesEnd PropertyPrivate Property Get TabSpaces()TabSpaces = m_TabSpacesEnd PropertyPublic Property Let TableBGColor(inColor)m_TableBGColor = inColorEnd PropertyPrivate Property Get TableBGColor()TableBGColor = m_TableBGColorEnd PropertyPublic Property Get ProcessingTime()ProcessingTime = Second(m_EndTime - m_StartTime)End PropertyPublic Property Get LineCount()LineCount = m_LineCountEnd PropertyPublic Property Get PathToFile()PathToFile = m_strPathToFileEnd PropertyPublic Property Let PathToFile(inPath)m_strPathToFile = inPathEnd PropertyPrivate Property Let KeyMin(inMin)m_intKeyMin = inMinEnd PropertyPrivate Property Get KeyMin()KeyMin = m_intKeyMinEnd PropertyPrivate Property Let KeyMax(inMax)m_intKeyMax = inMaxEnd PropertyPrivate Property Get KeyMax()KeyMax = m_intKeyMaxEnd PropertyPrivate 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 SubPrivate Function Min(x, y)Dim tempMinIf x < y Then tempMin = x Else tempMin = yMin = tempMinEnd FunctionPrivate Function Max(x, y)Dim tempMaxIf x > y Then tempMax = x Else tempMax = yMax = tempMaxEnd FunctionPublic Sub AddKeyword(inKeyword, inToken)KeyMin = Min(Len(inKeyword), KeyMin)KeyMax = Max(Len(inKeyword), KeyMax)objDict.Add LCase(inKeyword), inTokenEnd SubPublic Sub ParseFile(blnOutputHTML)Dim m_strReadLine, tempString, blnInScriptBlock, blnGoodExtension, iDim blnEmptyLinem_LineCount = 0If Len(PathToFile) = 0 ThenErr.Raise 5, "cBuffer: PathToFile Length Zero"Exit SubEnd IfSelect Case LCase(Right(PathToFile, 3))Case "asp", "inc"blnGoodExtension = TrueCase ElseblnGoodExtension = FalseEnd SelectIf Not blnGoodExtension ThenErr.Raise 5, "cBuffer: File extension not asp or inc"Exit SubEnd IfSet objFile = objFSO.OpenTextFile(server.MapPath(PathToFile))Response.Write ""Response.Write ""m_StartTime = Time()Do While Not objFile.AtEndOfStreamm_strReadLine = objFile.ReadLineblnEmptyLine = FalseIf Len(m_strReadLine) = 0 ThenblnEmptyLine = TrueEnd Ifm_strReadLine = Replace(m_strReadLine, vbTab, TabSpaces)m_LineCount = m_LineCount + 1tempString = 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) ThenResponse.Write ""Response.Write server.HTMLEncode(m_strReadLine)Response.Write ""blnInScriptBlock = False' Check for an opening script tagElseIf Left( tempString, 2) = Chr(60) & "%" Then' Check for a closing script tag on the same lineIf right( RTrim(tempString), 2 ) = "%" & Chr(62) ThenResponse.Write "<%"Response.Write ""Response.Write CharacterParse(mid(m_strReadLine, 3, Len(m_strReadLine) - 4))Response.Write ""Response.Write "%gt;"blnInScriptBlock = FalseElseResponse.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/commentsblnInScriptBlock = TrueEnd IfElseIf blnInScriptBlock ThenIf blnEmptyLine ThenResponse.Write vbCrLfElseIf right(tempString, 2) = "%" & Chr(62) ThenResponse.Write "%>"blnInScriptBlock = FalseElseResponse.Write CharacterParse(m_strReadLine) & vbCrLfEnd IfEnd IfElseIf blnOutputHTML ThenIf blnEmptyLine ThenResponse.Write vbCrLfElseResponse.Write server.HTMLEncode(m_strReadLine) & vbCrLfEnd IfEnd IfEnd IfEnd IfLoop' Grab the time at the completion of processingm_EndTime = Time()' Close the outside tableResponse.Write ""' Close the file and destroy the file objectobjFile.closeSet objFile = NothingEnd Sub' This function parses a line character by characterPrivate Function CharacterParse(inLine)Dim charBuffer, tempChar, i, outputStringDim insideString, workString, holdCharinsideString = FalseoutputString = ""For i = 1 to Len(inLine)tempChar = mid(inLine, i, 1)Select Case tempCharCase " "If Not insideString ThencharBuffer = charBuffer & " "If charBuffer <>" " ThenIf left(charBuffer, 1) = " " Then outputString = outputString & " "' Check for a 'rem' style comment markerIf LCase(Trim(charBuffer)) = "rem" ThenoutputString = outputString & CommentColoroutputString = outputString & "REM"workString = mid( inLine, i, Len(inLine))workString = replace(workString, "<", "＆ｌｔ；")workString = replace(workString, ">", "＆ｇｔ；")outputString = outputString & workString & ""charBuffer = ""Exit ForEnd IfoutputString = outputString & FindReplace(Trim(charBuffer))If right(charBuffer, 1) = " " Then outputString = outputString & " "charBuffer = ""End IfElseoutputString = outputString & " "End IfCase "("If left(charBuffer, 1) = " " ThenoutputString = outputString & " "End IfoutputString = 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 stringinsideString = Not insideStringIf insideString ThenoutputString = outputString & StringColoroutputString = outputString & "＆ｑｕｏｔ；"ElseoutputString = outputString & """"outputString = outputString & ""End IfCase "'"' Catch comments and output the rest of the line' as a comment IF we're not inside a string.If Not insideString ThenoutputString = outputString & CommentColorworkString = mid( inLine, i, Len(inLine))workString = replace(workString, "<", "＆ｌｔ；")workString = replace(workString, ">", "＆ｇｔ；")outputString = outputString & workStringoutputString = outputString & ""Exit ForElseoutputString = outputString & "'"End IfCase 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 variableIf insideString ThenoutputString = outputString & tempCharElsecharBuffer = charBuffer & tempCharEnd IfEnd SelectNext' Deal with the last part of the string in the character bufferIf Left(charBuffer, 1) = " " ThenoutputString = outputString & " "End If' Check for closing parentheses at the end of a stringIf right(charBuffer, 1) = ")" ThencharBuffer = Left(charBuffer, Len(charBuffer) - 1)CharacterParse = outputString & FindReplace(Trim(charBuffer)) & ")"Exit FunctionEnd IfCharacterParse = outputString & FindReplace(Trim(charBuffer))End Function' return true or false if a passed in number is between KeyMin and KeyMaxPrivate Function InRange(inLen)If inLen >= KeyMin And inLen <= KeyMax ThenInRange = TrueExit FunctionEnd IfInRange = FalseEnd 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 KeyMaxIf InRange(Len(inToken)) ThenIf objDict.Exists(inToken) ThenFindReplace = CodeColor & objDict.Item(inToken) & ""Exit FunctionEnd IfEnd 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 functionFindReplace = inTokenEnd FunctionEnd 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 classDim objBuffer' Set up the error handlingOn Error Resume Next' create the instance of the cBuffer classSet 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 purposesobjBuffer.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'tobjBuffer.ParseFile False '注意：显示代码的response.write已经在class中。这里调用方法就可以了。' Check for errors that may have been raised and write them outIf Err.number <> 0 ThenResponse.Write Err.number & ":" & Err.description & ":" & Err.source & ""End If' Output the processing time and number of lines processed by the scriptResponse.Write "Processing Time: " & objBuffer.ProcessingTime & " seconds"Response.Write "Lines Processed: " & objBuffer.LineCount & ""' Destroy the instance of our cBuffer classSet objBuffer = Nothing%>

....