为了演示高亮效果，下面就不用论坛自带的高亮了哈~
————————————————————————————————————————————————
Rem Vbs-HighLight Ver2.0 BY 老刘
Rem HTML特殊字符及标签处理感谢bbaa
Rem 灵感 From Demon's Vbs-Beautifier
Rem 常量设置
STRING_FLAG = Chr(1)
COMMENT_FLAG = Chr(2)
BLANK_FLAG = Chr(3)
SPECIAL_CHAR_FLAG = Chr(4)
[符号集合] = ",./\()<=>+-*^&"
[保留字集合] = Split("And As Boolean ByRef Byte ByVal Call Case Class Const Currency Debug Dim Do Double Each Else ElseIf Empty End EndIf Enum Eqv Event Exit Explicit False For Function Get Goto If Imp Implements In Integer Is Let Like Long Loop LSet Me Mod New Next Not Nothing Null On Option Optional Or ParamArray Preserve Private Property Public RaiseEvent ReDim Resume RSet Select Set Shared Single Static Stop Sub Then To True Type TypeOf Until Variant WEnd While With Xor"," ")
[内置函数集合] = Split("Abs Array Asc Atn CBool CByte CCur CDate CDbl CInt CLng CSng CStr Chr Cos CreateObject Date DateAdd DateDiff DatePart DateSerial DateValue Day Escape Eval Exp Filter Fix FormatCurrency FormatDateTime FormatNumber FormatPercent GetLocale GetObject GetRef Hex Hour InStr InStrRev InputBox Int IsArray IsDate IsEmpty IsNull IsNumeric IsObject Join LBound LCase LTrim Left Len LoadPicture Log Mid Minute Month MonthName MsgBox Now Oct Randomize RGB RTrim Replace Right Rnd Round ScriptEngine ScriptEngineBuildVersion ScriptEngineMajorVersion ScriptEngineMinorVersion Second SetLocale Sgn Sin Space Split Sqr StrComp StrReverse String Tan Time TimeSerial TimeValue Timer Trim TypeName UBound UCase Unescape VarType Weekday WeekdayName Year"," ")
[内置常量集合] = Split("vbBlack vbRed vbGreen vbYellow vbBlue vbMagenta vbCyan vbWhite vbBinaryCompare vbTextCompare vbSunday vbMonday vbTuesday vbWednesday vbThursday vbFrIDAy vbSaturday vbUseSystemDayOfWeek vbFirstJan1 vbFirstFourDays vbFirstFullWeek vbGeneralDate vbLongDate vbShortDate vbLongTime vbShortTime vbObjectError vbOKOnly vbOKCancel vbAbortRetryIgnore vbYesNoCancel vbYesNo vbRetryCancel vbCritical vbQuestion vbExclamation vbInformation vbDefaultButton1 vbDefaultButton2 vbDefaultButton3 vbDefaultButton4 vbApplicationModal vbSystemModal vbOK vbCancel vbAbort vbRetry vbIgnore vbYes vbNo vbCr vbCrLf vbFormFeed vbLf vbNewLine vbNullChar vbNullString vbTab vbVerticalTab vbUseDefault vbTrue vbFalse vbEmpty vbNull vbInteger vbLong vbSingle vbDouble vbCurrency vbDate vbString vbObject vbError vbBoolean vbVariant vbDataObject vbDecimal vbByte vbArray WScript Wsh"," ")
Rem 正则对象初始化
Set re = New RegExp
re.Global = True
re.IgnoreCase = True
re.MultiLine = False
Rem 检测宿主
Const [宿主] = "CSCRIPT.EXE"
If Not UCase(Right(WScript.FullName,11)) = UCase([宿主]) Then
MsgBox "请用Cscript.EXE作为宿主运行该脚本。"
WScript.Quit 1
End If
Rem 读取文件
On Error Resume Next
strCode = CreateObject("Scripting.FileSystemObject"). _
GetFile(WScript.Arguments(1)). _
OpenAsTextStream(1). _
ReadAll
If Err.Number <> 0 Or Wsh.Arguments.Count <> 2 Then
Wsh.Echo "老刘编写——VBS代码高亮/着色工具 Version 2.0"
Wsh.StdOut.WriteBlankLines 1
Wsh.Echo "使用方法："
Wsh.Echo " Cscript -Nologo ThisVbs </UBB|/HTML> 你的Vbscript.vbs"
Wsh.StdOut.WriteBlankLines 1
Wsh.Echo "UBB模式局限： 代码中不能出现明文UBB标签。"
Wsh.Echo "特别鸣谢： bbaa"
Wsh.Quit 1
End If
On Error Goto 0
Rem 确定着色方案及HTML特殊符号预处理
Select Case UCase(Wsh.Arguments(0))
Case "/HTML"
[着色标签] = "<span style=""color:|ReplaceHere|;"">$1</span>"
[换行标签] = "<br>"
[空白字符] = " "
strCode = Replace(strCode,"&",SPECIAL_CHAR_FLAG&"amp;")
strCode = Replace(strCode,">",SPECIAL_CHAR_FLAG&"gt;")
strCode = Replace(strCode,"<",SPECIAL_CHAR_FLAG&"lt;")
Case "/UBB"
[着色标签] = Chr(&H5B)&Chr(&H63)&Chr(&H6F)&Chr(&H6C)&Chr(&H6F)&Chr(&H72)&Chr(&H3D)&Chr(&H7C)&Chr(&H52)&Chr(&H65)&Chr(&H70)&Chr(&H6C)&Chr(&H61)&Chr(&H63)&Chr(&H65)&Chr(&H48)&Chr(&H65)&Chr(&H72)&Chr(&H65)&Chr(&H7C)&Chr(&H5D)&Chr(&H24)&Chr(&H31)&Chr(&H5B)&Chr(&H2F)&Chr(&H63)&Chr(&H6F)&Chr(&H6C)&Chr(&H6F)&Chr(&H72)&Chr(&H5D)
[换行标签] = VbNewLine
[空白字符] = " "
Case Else
Wsh.Quit 1
End Select
Rem 预处理字符串
re.Pattern = """.*?"""
Set [字符串集合] = re.Execute(strCode)
strCode = re.Replace(strCode, STRING_FLAG)
Rem 预处理空字符
strCode = Replace(strCode,Chr(9)," ")
strCode = Replace(strCode," ",BLANK_FLAG)
Rem 预处理换行
strCode = Replace(strCode,vbNewLine,vbCr)
strCode = Replace(strCode,vbLf,vbCr)
Rem 预处理注释
re.Pattern = "((?:\x03*Rem\x03+|')[^\r]*)" '在此严重的感谢bbaa指导
Set [注释集合] = re.Execute(strCode)
strCode = re.Replace(strCode, COMMENT_FLAG)
Rem 添加着色标签以及HTML特殊符号处理
With re
Rem 偷懒操作，用正则将符号集合替换为正则表达式，再用替换出来的正则表达式处理strCode。
Rem 下面三行的代码完成了 ",./\()<=>+-*&^" ==> "(\,|\.|\/|\\|\(|\)|\<|\=|\>|\+|\-|\*|\&|\^)"
.Pattern = ""
.Pattern = re.Replace([符号集合],"|\")
.Pattern = "(" & Left(Right(.Pattern,Len(.Pattern) - 1),Len(.Pattern) - 3) & ")"
strCode = .Replace(StrCode,Replace([着色标签],"|ReplaceHere|","DarkOrange"))
End With
If UCase(WSH.Arguments(0))="/HTML" Then
strCode = Replace(strCode,SPECIAL_CHAR_FLAG&"amp;","<span style=""color:DarkOrange;"">"&SPECIAL_CHAR_FLAG&"amp;"&"</span>")
strCode=Replace(strCode,SPECIAL_CHAR_FLAG&"gt;","<span style=""color:DarkOrange;"">"&SPECIAL_CHAR_FLAG&"gt;"&"</span>")
strCode=Replace(strCode,SPECIAL_CHAR_FLAG&"lt;","<span style=""color:DarkOrange;"">"&SPECIAL_CHAR_FLAG&"lt;"&"</span>")
End If
For Each [保留字] In [保留字集合]
re.Pattern = "\b("&[保留字]&")\b"
strCode = re.Replace(strCode, Replace([着色标签],"|ReplaceHere|","DeepSkyBlue"))
Next
For Each [内置函数] In [内置函数集合]
re.Pattern = "\b("&[内置函数]&")\b"
strCode = re.Replace(strCode, Replace([着色标签],"|ReplaceHere|","Red"))
Next
For Each [内置常量] In [内置常量集合]
re.Pattern = "\b("&[内置常量]&")\b"
strCode = re.Replace(strCode, Replace([着色标签],"|ReplaceHere|","Blue"))
Next
Rem 处理注释
For Each [注释] In [注释集合]
strCode = Replace(strCode, COMMENT_FLAG, _
Replace(Replace([着色标签],"|ReplaceHere|","Green"),"$1",[注释]), 1, 1) 'or #00ff00
Next
Rem 处理字符串
For Each [字符串] In [字符串集合]
strCode = Replace(strCode, STRING_FLAG, _
Replace(Replace([着色标签],"|ReplaceHere|","Gray"),"$1",[字符串]), 1, 1)
Next
Rem 处理换行和空字符
strCode = Replace(strCode,vbCr,[换行标签])
strCode = Replace(strCode,BLANK_FLAG,[空白字符])
If UCase(WSH.Arguments(0))="/HTML" Then
strCode = Replace(strCode,SPECIAL_CHAR_FLAG,Chr(&H26))
End If
发表于 2018-2-10 16:33
