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))
文章整理：西部数码--专业提供域名注册、虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息，谢谢!
