复制代码 代码如下:
<%
ClasscBuffer
PrivateobjFSO,objFile,objDict
Privatem_strPathToFile,m_TableBGColor,m_StartTime
Privatem_EndTime,m_LineCount,m_intKeyMin,m_intKeyMax
Privatem_CodeColor,m_CommentColor,m_StringColor,m_TabSpaces
PrivateSubClass_Initialize()
TableBGColor="white"
CodeColor="Blue"
CommentColor="Green"
StringColor="Gray"
TabSpaces=""
PathToFile=""
m_StartTime=0
m_EndTime=0
m_LineCount=0
KeyMin=2
KeyMax=8
SetobjDict=server.CreateObject("Scripting.Dictionary")
objDict.CompareMode=1
CreateKeywords
SetobjFSO=server.CreateObject("Scripting.FileSystemObject")
EndSub
PrivateSubClass_Terminate()
SetobjDict=Nothing
SetobjFSO=Nothing
EndSub
PublicPropertyLetCodeColor(inColor)
m_CodeColor="<fontcolor="&inColor&"><Strong>"
EndProperty
PrivatePropertyGetCodeColor()
CodeColor=m_CodeColor
EndProperty
PublicPropertyLetCommentColor(inColor)
m_CommentColor="<fontcolor="&inColor&">"
EndProperty
PrivatePropertyGetCommentColor()
CommentColor=m_CommentColor
EndProperty
PublicPropertyLetStringColor(inColor)
m_StringColor="<fontcolor="&inColor&">"
EndProperty
PrivatePropertyGetStringColor()
StringColor=m_StringColor
EndProperty
PublicPropertyLetTabSpaces(inSpaces)
m_TabSpaces=inSpaces
EndProperty
PrivatePropertyGetTabSpaces()
TabSpaces=m_TabSpaces
EndProperty
PublicPropertyLetTableBGColor(inColor)
m_TableBGColor=inColor
EndProperty
PrivatePropertyGetTableBGColor()
TableBGColor=m_TableBGColor
EndProperty
PublicPropertyGetProcessingTime()
ProcessingTime=Second(m_EndTime-m_StartTime)
EndProperty
PublicPropertyGetLineCount()
LineCount=m_LineCount
EndProperty
PublicPropertyGetPathToFile()
PathToFile=m_strPathToFile
EndProperty
PublicPropertyLetPathToFile(inPath)
m_strPathToFile=inPath
EndProperty
PrivatePropertyLetKeyMin(inMin)
m_intKeyMin=inMin
EndProperty
PrivatePropertyGetKeyMin()
KeyMin=m_intKeyMin
EndProperty
PrivatePropertyLetKeyMax(inMax)
m_intKeyMax=inMax
EndProperty
PrivatePropertyGetKeyMax()
KeyMax=m_intKeyMax
EndProperty
PrivateSubCreateKeywords()
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"
EndSub
PrivateFunctionMin(x,y)
DimtempMin
Ifx<yThentempMin=xElsetempMin=y
Min=tempMin
EndFunction
PrivateFunctionMax(x,y)
DimtempMax
Ifx>yThentempMax=xElsetempMax=y
Max=tempMax
EndFunction
PublicSubAddKeyword(inKeyword,inToken)
KeyMin=Min(Len(inKeyword),KeyMin)
KeyMax=Max(Len(inKeyword),KeyMax)
objDict.AddLCase(inKeyword),inToken
EndSub
PublicSubParseFile(blnOutputHTML)
Dimm_strReadLine,tempString,blnInScriptBlock,blnGoodExtension,i
DimblnEmptyLine
m_LineCount=0
IfLen(PathToFile)=0Then
Err.Raise5,"cBuffer:PathToFileLengthZero"
ExitSub
EndIf
SelectCaseLCase(Right(PathToFile,3))
Case"asp","inc"
blnGoodExtension=True
CaseElse
blnGoodExtension=False
EndSelect
IfNotblnGoodExtensionThen
Err.Raise5,"cBuffer:Fileextensionnotasporinc"
ExitSub
EndIf
SetobjFile=objFSO.OpenTextFile(server.MapPath(PathToFile))
Response.Write"<tablenowrapbgcolor="&TableBGColor&"cellpadding=0cellspacing=0>"
Response.Write"<tr><td><PRE>"
m_StartTime=Time()
DoWhileNotobjFile.AtEndOfStream
m_strReadLine=objFile.ReadLine
blnEmptyLine=False
IfLen(m_strReadLine)=0Then
blnEmptyLine=True
EndIf
m_strReadLine=Replace(m_strReadLine,vbTab,TabSpaces)
m_LineCount=m_LineCount+1
tempString=LTrim(m_strReadLine)
'Checkforthetopscriptlinethatset'sthedefaultscriptlanguage
'forthepage.
Ifleft(tempString,3)=Chr(60)&"%@"Andright(tempString,2)="%"&Chr(62)Then
Response.Write"<table><trbgcolor=yellow><td>"
Response.Writeserver.HTMLEncode(m_strReadLine)
Response.Write"</td></tr></table>"
blnInScriptBlock=False
'Checkforanopeningscripttag
ElseIfLeft(tempString,2)=Chr(60)&"%"Then
'Checkforaclosingscripttagonthesameline
Ifright(RTrim(tempString),2)="%"&Chr(62)Then
Response.Write"<table><tr><tdbgcolor=yellow><%</td>"
Response.Write"<td>"
Response.WriteCharacterParse(mid(m_strReadLine,3,Len(m_strReadLine)-4))
Response.Write"</td>"
Response.Write"<tdbgcolor=yellow>%gt;</td></tr></table>"
blnInScriptBlock=False
Else
Response.Write"<table><trbgcolor=yellow><td><%</td></tr></table>"
'We'vegotanopeningscripttagsosettheflagtotrueso
'thatweknowtostartparsingthelinesforkeywords/comments
blnInScriptBlock=True
EndIf
Else
IfblnInScriptBlockThen
IfblnEmptyLineThen
Response.WritevbCrLf
Else
Ifright(tempString,2)="%"&Chr(62)Then
Response.Write"<table><trbgcolor=yellow><td>%></td></tr></table>"
blnInScriptBlock=False
Else
Response.WriteCharacterParse(m_strReadLine)&vbCrLf
EndIf
EndIf
Else
IfblnOutputHTMLThen
IfblnEmptyLineThen
Response.WritevbCrLf
Else
Response.Writeserver.HTMLEncode(m_strReadLine)&vbCrLf
EndIf
EndIf
EndIf
EndIf
Loop
'Grabthetimeatthecompletionofprocessing
m_EndTime=Time()
'Closetheoutsidetable
Response.Write"</PRE></td></tr></table>"
'Closethefileanddestroythefileobject
objFile.close
SetobjFile=Nothing
EndSub
'Thisfunctionparsesalinecharacterbycharacter
PrivateFunctionCharacterParse(inLine)
DimcharBuffer,tempChar,i,outputString
DiminsideString,workString,holdChar
insideString=False
outputString=""
Fori=1toLen(inLine)
tempChar=mid(inLine,i,1)
SelectCasetempChar
Case""
IfNotinsideStringThen
charBuffer=charBuffer&""
IfcharBuffer<>""Then
Ifleft(charBuffer,1)=""ThenoutputString=outputString&""
'Checkfora'rem'stylecommentmarker
IfLCase(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=""
ExitFor
EndIf
outputString=outputString&FindReplace(Trim(charBuffer))
Ifright(charBuffer,1)=""ThenoutputString=outputString&""
charBuffer=""
EndIf
Else
outputString=outputString&""
EndIf
Case"("
Ifleft(charBuffer,1)=""Then
outputString=outputString&""
EndIf
outputString=outputString&FindReplace(Trim(charBuffer))&"("
charBuffer=""
CaseChr(60)
outputString=outputString&"<"
CaseChr(62)
outputString=outputString&">"
CaseChr(34)
'catchquotecharsandflipabooleanvariabletodenotethat
'whetherornotwe're"inside"aquotedstring
insideString=NotinsideString
IfinsideStringThen
outputString=outputString&StringColor
outputString=outputString&"＆ｑｕｏｔ；"
Else
outputString=outputString&""""
outputString=outputString&"</font>"
EndIf
Case"'"
'Catchcommentsandoutputtherestoftheline
'asacommentIFwe'renotinsideastring.
IfNotinsideStringThen
outputString=outputString&CommentColor
workString=mid(inLine,i,Len(inLine))
workString=replace(workString,"<","＆ｌｔ；")
workString=replace(workString,">","＆ｇｔ；")
outputString=outputString&workString
outputString=outputString&"</font>"
ExitFor
Else
outputString=outputString&"'"
EndIf
CaseElse
'We'vedealtwithspecialcasecharacterssonow
'we'llbeginaddingcharacterstoouroutputString
'orcharBufferdependingonthestateoftheinsideString
'booleanvariable
IfinsideStringThen
outputString=outputString&tempChar
Else
charBuffer=charBuffer&tempChar
EndIf
EndSelect
Next
'Dealwiththelastpartofthestringinthecharacterbuffer
IfLeft(charBuffer,1)=""Then
outputString=outputString&""
EndIf
'Checkforclosingparenthesesattheendofastring
Ifright(charBuffer,1)=")"Then
charBuffer=Left(charBuffer,Len(charBuffer)-1)
CharacterParse=outputString&FindReplace(Trim(charBuffer))&")"
ExitFunction
EndIf
CharacterParse=outputString&FindReplace(Trim(charBuffer))
EndFunction
'returntrueorfalseifapassedinnumberisbetweenKeyMinandKeyMax
PrivateFunctionInRange(inLen)
IfinLen>=KeyMinAndinLen<=KeyMaxThen
InRange=True
ExitFunction
EndIf
InRange=False
EndFunction
'Evaluatethepassedinstringandseeifit'sakeywordinthe
'dictionary.Ifitiswewilladdhtmlformattingtothestring
'andreturnittothecaller.Otherwisejustreturnthesame
'stringaswaspassedin.
PrivateFunctionFindReplace(inToken)
'Checkthelengthtomakesureit'swithintherangeofKeyMinandKeyMax
IfInRange(Len(inToken))Then
IfobjDict.Exists(inToken)Then
FindReplace=CodeColor&objDict.Item(inToken)&"</Strong></Font>"
ExitFunction
EndIf
EndIf
'Keywordiseithertooshortortoolongordoesn'texistinthe
'dictionarysowe'lljustreturnwhatwaspassedintothefunction
FindReplace=inToken
EndFunction
EndClass
%>
<>
<%'*************************************************************************
'Thisisalltest/examplecodeshowingthecallingsyntaxofthe
'cBufferclass...theinterfacetothecBufferobjectisquitesimple.
'
'Useitforreference...deleteit...whatever.
'*************************************************************************
REMThisisaremtypecommentjustfortestingpurposes!
'ThisvariablewillholdaninstanceofthecBufferclass
DimobjBuffer
'Setuptheerrorhandling
OnErrorResumeNext
'createtheinstanceofthecBufferclass
SetobjBuffer=NewcBuffer
'SetthePathToFilepropertyofthecBufferclass
'
'Justforkickswe'llusetheaspfilethatwecreated
'inthelastinstallmentofthisarticleseriesfortestingpurposes
objBuffer.PathToFile="../081899/random.asp"'这是文件名啦。
'Here'sanexampleofhowtoaddanewkeywordtothekeywordarray
'Youcouldaddalistofyourownfunctionnames,variablesorwhatever...cool!
'NOTE:YoucanadddifferentHTMLformattingifyoulike,the<strong>
'attributewillappliedtoallkeywords...thisislikelytochange
'inthenearfuture.
'
'objBuffer.AddKeyword"response.write","<fontcolor=Red>Response.Write</font>"
'Hereareexamplesofchangingthetablebackgroundcolor,codecolor,
'commentcolor,stringcolorandtabspaceproperties
'
'objBuffer.TableBGColor="LightGrey"'or
'objBuffer.TableBGColor="#ffffdd"'simpleright?
'objBuffer.CodeColor="Red"
'objBuffer.CommentColor="Orange"
'objBuffer.StringColor="Purple"
'objBuffer.TabSpaces=""
'CalltheParseFilemethodofthecBufferclass,passittrueifyouwantthe
'HTMLcontainedinthepageoutputorfalseifyoudon't
objBuffer.ParseFileFalse'注意：显示代码的response.write已经在class中。这里调用方法就可以了。
'Checkforerrorsthatmayhavebeenraisedandwritethemout
IfErr.number<>0Then
Response.WriteErr.number&":"&Err.description&":"&Err.source&"<br>"
EndIf
'Outputtheprocessingtimeandnumberoflinesprocessedbythescript
Response.Write"<strong>ProcessingTime:</strong>"&objBuffer.ProcessingTime&"seconds<br>"
Response.Write"<strong>LinesProcessed:</strong>"&objBuffer.LineCount&"<br>"
'DestroytheinstanceofourcBufferclass
SetobjBuffer=Nothing
%>