日本高清在线观看免费视频,好紧好爽好多水视频465视频,AV 丝袜天堂网,加勒比久久综合网天天,高清亚洲日韩欧洲不卡在线3D,99re热这里只有精品22,久久综合少妇11p,国产亚洲一区二区精品,成年女人免费高清视频,JIZZJIZZ日本护士高清喷

[點晴永久免費OA]VBS、ASP代碼語法加亮顯示的類

當前位置：點晴教程→點晴OA辦公管理信息系統(tǒng) →『經驗分享&問題答疑』

admin

2022年7月5日 1:29 本文熱度 745

代碼如下:
<%
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
%>


<% ' *************************************************************************
' 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 class
Dim objBuffer

' Set up the error handling
On Error Resume Next

' create the instance of the cBuffer class
Set 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 purposes
objBuffer.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 <strong>
' attribute will applied to all keywords ... this is likely to change
' in the near future.
'
'objBuffer.AddKeyword "response.write", "<font color=Red>Response.Write</font>"

' 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't
objBuffer.ParseFile False '注意：顯示代碼的response.write已經在class中。這里調用方法就可以了。

' Check for errors that may have been raised and write them out
If Err.number <> 0 Then
Response.Write Err.number & ":" & Err.description & ":" & Err.source & "<br>"
End If

' Output the processing time and number of lines processed by the script
Response.Write "<strong>Processing Time:</strong> " & objBuffer.ProcessingTime & " seconds<br>"
Response.Write "<strong>Lines Processed:</strong> " & objBuffer.LineCount & "<br>"

' Destroy the instance of our cBuffer class
Set objBuffer = Nothing
%>

該文章在 2022/7/5 1:29:13 編輯過

關鍵字查詢

代碼

顯示

正在查詢...

點晴ERP是一款針對中小制造業(yè)的專業(yè)生產管理軟件系統(tǒng),系統(tǒng)成熟度和易用性得到了國內大量中小企業(yè)的青睞。

點晴PMS碼頭管理系統(tǒng)主要針對港口碼頭集裝箱與散貨日常運作、調度、堆場、車隊、財務費用、相關報表等業(yè)務管理，結合碼頭的業(yè)務特點，圍繞調度、堆場作業(yè)而開發(fā)的。集技術的先進性、管理的有效性于一體，是物流碼頭及其他港口類企業(yè)的高效ERP管理信息系統(tǒng)。

點晴WMS倉儲管理系統(tǒng)提供了貨物產品管理,銷售管理,采購管理,倉儲管理,倉庫管理,保質期管理,貨位管理,庫位管理,生產管理,WMS管理系統(tǒng),標簽打印,條形碼,二維碼管理,批號管理軟件。

點晴免費OA是一款軟件和通用服務都免費，不限功能、不限時間、不限用戶的免費OA協(xié)同辦公管理系統(tǒng)。

[點晴永久免費OA]VBS、ASP代碼語法加亮顯示的類

[點晴永久免費OA]VBS、ASP代碼語法加亮顯示的類