本帖最后由 jyswjjgdwtdtj 于 2023-5-16 18:40 编辑
保存为format.vbs- uselesswords="As Boolean Byte Currency Double Empty EndIf Enum Implements Integer Like Long LSet Optional "&_
- "ParamArray RaiseEvent RSet Shared Single Static Type TypeOf Variant"
- specialwords="Debug Stop"
- reservedwords="ByRef ByVal Call Case Class Const Dim Do Each Else ElseIf End Event Exit Explicit "&_
- "False For Function Get Goto If In Let Loop Me "&_
- "New Next Nothing Null On Option Preserve Private Property Public "&_
- "ReDim Rem Resume Select Set Sub Step Then To True "&_
- "Until WEnd While With"
- functions="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"
- constants="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 Err"
- replacedwords=reservedwords&" "&functions&" "&constants&" "&specialwords
- operators="Mod Eqv And Not Or Xor Is Imp"
- sym=split("+ / \ < > = <= >= <> ( ) * -"," ")
- symto=split("@add@ @div@ @extdiv@ @lt@ @gt@ @eq@ @ngt@ @nlt@ @neq@ @lb@ @rb@ @mul@ @sbt@"," ")
- Class formatcode
- Private Sub Class_Initialize()
- End Sub
- Public Function word(code)
- Dim strings,comments
- With New RegExp
- .global=True
- .ignorecase=True
- 'space
- .pattern="[ ]"
- code=.replace(code," ")
- 'STRING
- .pattern=""".*?"""
- Set strings=.execute(code)
- code=.Replace(code,"@0String0@")
- 'COMMENT
- .pattern="('|rem\s).*"
- Set comments=.execute(code)
- code=.replace(code,"@comment@")
- 'RESERVEDWORD
- for i=0 to ubound(sym)
- code=replace(code,sym(i),symto(i))
- next
- For Each w In Split(uselesswords," ")
- .pattern = "(\b)" & w & "(\b)"
- code = .replace(code, "$1<span c_lass=uselesswords>" & w & "</span>$2")
- Next
- For Each w In Split(functions," ")
- .pattern = "(\b)" & w & "(\b)"
- code = .replace(code, "$1<span c_lass=functions>" & w & "</span>$2")
- Next
- For Each w In Split(constants," ")
- .pattern = "(\b)" & w & "(\b)"
- code = .replace(code, "$1<span c_lass=variants>" & w & "</span>$2")
- Next
- For Each w In Split(reservedwords," ")
- .pattern = "(\b)" & w & "(\b)"
- code = .replace(code, "$1<span c_lass=reservedwords>" & w & "</span>$2")
- Next
- For Each w In Split(specialwords," ")
- .pattern = "(\b)" & w & "(\b)"
- code = .replace(code, "$1<span c_lass=specialwords>" & w & "</span>$2")
- Next
- For Each w In Split(operators," ")
- .pattern = "(\b)" & w & "(\b)"
- code = .replace(code, "$1<span c_lass=operators>" & w & "</span>$2")
- Next
- For Each s In strings
- code=Replace(code,"@0String0@","<span c_lass=string>"&s&"</span>",1,1)
- Next
- For Each c In comments
- code=Replace(code,"@comment@","<span c_lass=comment>"&c&"</span>",1,1)
- Next
- for i=0 to ubound(sym)
- code=replace(code,symto(i),"<span class=operators>"&sym(i)&"</span>")
- next
- code=Replace(code,"c_lass","class")
- word=code
- End with
- End Function
- Function Space(code)
- variate="([a-zA-Z][a-zA-Z0-9_]*|\[[a-zA-Z0-9_]*\]|-?[0-9]+|"".*?"")"
- lspace=replace(code,ltrim(code),"")
- code=ltrim(code)
- if rtrim(code)<>code then rspace=1
- code=rtrim(code)
- With New RegExp
- .Global = True
- .IgnoreCase = True
- .pattern=""".*?"""
- Set strings=.execute(code)
- code=.Replace(code,"@String@")
- .pattern="('|rem\s).*"
- Set comments=.execute(code)
- code=.replace(code,"@comment@")
- .Pattern = "[ ]*(=|<|>|\+|&|\*|/|\^|\\)[ ]*"
- code = .Replace(code, " $1 ")
- .Pattern = "[ ]*<\s*>[ ]*"
- code = .Replace(code, " <> ")
- .Pattern = "[ ]*<\s*=[ ]*"
- code = .Replace(code, " <= ")
- .Pattern = "[ ]*>\s*=[ ]*"
- code = .Replace(code, " >= ")
- '.Pattern = "[ ]*_[ ]*$"
- 'code = .Replace(code, " _")
- .Pattern = "Do[ ]+(While|Until)[ ]*"
- code = .Replace(code, "Do $1")
- .Pattern = "End[ ]+(Sub|Function|If|Select|With|Class)[ ]*"
- code = .Replace(code, "End $1")
- .Pattern = "Select[ ]+Case[ ]+"&variate
- code = .Replace(code, "Select Case $1")
- .Pattern = "If[ ]+(.*?)[ ]+Then[ ]+(.*)$"
- code = .Replace(code, "If $1 Then $2")
- .pattern="for[ ]+"&variate&"[ ]+=[ ]+"&variate&"[ ]+to[ ]+"&variate
- code=.replace(code,"For $1 = $2 To $3")
- .pattern="for[ ]+each[ ]+"&variate&"[ ]+in[ ]+"&variate
- code=.replace(code,"For Each $1 In $2")
- For Each s In strings
- code=Replace(code,"@String@",s,1,1)
- Next
- For Each c In comments
- code=Replace(code,"@comment@",c,1,1)
- Next
- code=lspace&code
- if rspace=1 then code=code&" "
- End With
- Space=code
- End function
- End Class
- Set format=New formatcode
- function getleftspace(str)
- getleftspace=replace(str,ltrim(str),"")
- end function
复制代码
|