 |
|
|
 首页 |
名片设计 CorelDRAW Illustrator AuotoCAD Painter 其他软件 Photoshop Fireworks Flash |
|
<% 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>" 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 "</PRE></td></tr></table>" \\\' 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 & "</font>" 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 & "</font>" 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 & "</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) & "</Strong></Font>" 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 %> 使用前把里面的全角字符转变成半角的 返回类别: 教程 上一教程: 随机产生用户密码 下一教程: GLOBAL.ASA文件用法大全 您可以阅读与"VBS、ASP代码语法加亮显示的类(1)"相关的教程: · VBS、ASP代码语法加亮显示的类(2) · 加亮显示ASP文章原代码 · ASP中几种分页显示的比较 · ASP中关于帖子分页显示的基本方式 · 仿照CHINAASP论坛中TOP10写的部分显示代码 |
  |
| 快精灵印艺坊 版权所有 |
首页 会员中心在线印刷在线编辑付款方式索取样品设计指南连锁门店
|
||
