VBS、ASP代码语法加亮显示的类

　　复制代码 代码如下:
<%
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)

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.Addabs,Abs
objDict.Addand,And
objDict.Addarray,Array
objDict.Addcall,Call
objDict.Addcbool,CBool
objDict.Addcbyte,CByte
objDict.Addccur,CCur
objDict.Addcdate,CDate
objDict.Addcdbl,CDbl
objDict.Addcint,CInt
objDict.Addclass,Class
objDict.Addclng,CLng
objDict.Addconst,Const
objDict.Addcsng,CSng
objDict.Addcstr,CStr
objDict.Adddate,Date
objDict.Adddim,Dim
objDict.Adddo,Do
objDict.Addloop,Loop
objDict.Addempty,Empty
objDict.Addeqv,Eqv
objDict.Adderase,Erase
objDict.Addexit,Exit
objDict.Addfalse,False
objDict.Addfix,Fix
objDict.Addfor,For
objDict.Addnext,Next
objDict.Addeach,Each
objDict.Addfunction,Function
objDict.Addglobal,Global
objDict.Addif,If
objDict.Addthen,Then
objDict.Addelse,Else
objDict.Addelseif,ElseIf
objDict.Addimp,Imp
objDict.Addint,Int
objDict.Addis,Is
objDict.Addlbound,LBound
objDict.Addlen,Len
objDict.Addmod,Mod
objDict.Addnew,New
objDict.Addnot,Not
objDict.Addnothing,Nothing
objDict.Addnull,Null
objDict.Addon,On
objDict.Adderror,Error
objDict.Addresume,Resume
objDict.Addoption,Option
objDict.Addexplicit,Explicit
objDict.Addor,Or
objDict.Addprivate,Private
objDict.Addproperty,Property
objDict.Addget,Get
objDict.Addlet,Let
objDict.Addset,Set
objDict.Addpublic,Public
objDict.Addredim,Redim
objDict.Addselect,Select
objDict.Addcase,Case
objDict.Addend,End
objDict.Addsgn,Sgn
objDict.Addstring,String
objDict.Addsub,Sub
objDict.Addtrue,True
objDict.Addubound,UBound
objDict.Addwhile,While
objDict.Addwend,Wend
objDict.Addwith,With
objDict.Addxor,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))
Caseasp,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)

Checkforthetopscriptlinethatsetsthedefaultscriptlanguage
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>
Wevegotanopeningscripttagsosettheflagtotrueso
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&

Checkforaremstylecommentmarker
IfLCase(Trim(charBuffer))=remThen
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
whetherornotwereinsideaquotedstring
insideString=NotinsideString
IfinsideStringThen
outputString=outputString&StringColor
outputString=outputString&＆ｑｕｏｔ；
Else
outputString=outputString&
outputString=outputString&</font>
EndIf
Case
Catchcommentsandoutputtherestoftheline
asacommentIFwerenotinsideastring.
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
Wevedealtwithspecialcasecharacterssonow
wellbeginaddingcharacterstoouroutputString
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

Evaluatethepassedinstringandseeifitsakeywordinthe
dictionary.Ifitiswewilladdhtmlformattingtothestring
andreturnittothecaller.Otherwisejustreturnthesame
stringaswaspassedin.
PrivateFunctionFindReplace(inToken)
CheckthelengthtomakesureitswithintherangeofKeyMinandKeyMax
IfInRange(Len(inToken))Then
IfobjDict.Exists(inToken)Then
FindReplace=CodeColor&objDict.Item(inToken)&</Strong></Font>
ExitFunction
EndIf
EndIf
Keywordiseithertooshortortoolongordoesntexistinthe
dictionarysowelljustreturnwhatwaspassedintothefunction
FindReplace=inToken
EndFunction

EndClass
%>





<!--#includefile=token.asp-->
<%*************************************************************************
Thisisalltest/examplecodeshowingthecallingsyntaxofthe
cBufferclass...theinterfacetothecBufferobjectisquitesimple.

Useitforreference...deleteit...whatever.
*************************************************************************

REMThisisaremtypecommentjustfortestingpurposes!

ThisvariablewillholdaninstanceofthecBufferclass
DimobjBuffer

Setuptheerrorhandling
OnErrorResumeNext

createtheinstanceofthecBufferclass
SetobjBuffer=NewcBuffer

SetthePathToFilepropertyofthecBufferclass

Justforkickswellusetheaspfilethatwecreated
inthelastinstallmentofthisarticleseriesfortestingpurposes
objBuffer.PathToFile=../081899/random.asp这是文件名啦。

Heresanexampleofhowtoaddanewkeywordtothekeywordarray
NOTE:YoucanadddifferentHTMLformattingifyoulike,the<strong>
attributewillappliedtoallkeywords...thisislikelytochange
inthenearfuture.

objBuffer.AddKeywordresponse.write,<fontcolor=Red>Response.Write</font>

Hereareexamplesofchangingthetablebackgroundcolor,codecolor,
commentcolor,stringcolorandtabspaceproperties

objBuffer.TableBGColor=LightGreyor
objBuffer.TableBGColor=#ffffddsimpleright?
objBuffer.CodeColor=Red
objBuffer.CommentColor=Orange
objBuffer.StringColor=Purple
objBuffer.TabSpaces=

CalltheParseFilemethodofthecBufferclass,passittrueifyouwantthe
HTMLcontainedinthepageoutputorfalseifyoudont
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
%>