Board logo

标题: [原创] [新版本2.0]VbsHighLight-Vbs代码着色工具 [打印本页]

作者: 老刘    时间: 2018-2-8 19:49     标题: [新版本2.0]VbsHighLight-Vbs代码着色工具

本帖最后由 老刘 于 2018-2-11 19:37 编辑

老刘编写——VBS代码高亮/着色工具 Version 2.0

                Cscript -Nologo ThisVbs </UBB|/HTML> 你的Vbscript.vbs

UBB模式局限:           代码中不能出现明文UBB标签。
特别鸣谢:                 bbaa

Rem Vbs-HighLight Ver2.0 BY 老刘
Rem HTML特殊字符及标签处理感谢bbaa
Rem 灵感 From Demon's Vbs-Beautifier

Rem 常量设置
[符号集合] = ",./\()<=>+-*^&"
[保留字集合] = 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). _
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>"
    [空白字符] = "&nbsp;"
    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"))

For Each [内置函数] In [内置函数集合]
    re.Pattern = "\b("&[内置函数]&")\b"
    strCode = re.Replace(strCode, Replace([着色标签],"|ReplaceHere|","Red"))

For Each [内置常量] In [内置常量集合]
    re.Pattern = "\b("&[内置常量]&")\b"
    strCode = re.Replace(strCode, Replace([着色标签],"|ReplaceHere|","Blue"))

Rem 处理注释
For Each [注释] In [注释集合]
    strCode = Replace(strCode, COMMENT_FLAG, _
        Replace(Replace([着色标签],"|ReplaceHere|","Green"),"$1",[注释]), 1, 1) 'or #00ff00

Rem 处理字符串
For Each [字符串] In [字符串集合]
    strCode = Replace(strCode, STRING_FLAG, _
        Replace(Replace([着色标签],"|ReplaceHere|","Gray"),"$1",[字符串]), 1, 1)

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

Rem 处理完成,输出
Wsh.Echo strCode

Rem 老刘,于2017小年。

欢迎光临 批处理之家 ( Powered by Discuz! 7.2