Welcome

首页 / 编程脚本 / 用VBS写的VBSCRIPT代码格式化工具VbsBeautifier

昨天在VBS吧看到一个精华帖《VBS代码格式化工具》,是用C++写的,区区VBS代码格式化,就不要劳C++大驾了吧,用VBS实现VBS代码格式化工具不是更自然么?

网上的VBS代码大部分都没有缩进,新手不知道要缩进,高手缩进了被某些个垃圾网站采集以后也就没有了缩进,还有以一些博客贴吧也会把缩进给吃掉。除了缩进之外,由于学VBS的大部分都是学批处理出身,代码风格还是跟写批处理一样难看。其实一般情况下用VbsEdit 5.2.4.0自带的代码格式化功能就行了,没有必要重复造轮子。只不过VbsEdit 5.2.4.0在格式化带有冒号的代码时不是很理想,加上我已经很久没有写过像样的VBS脚本了,所以还是决定造一下轮子。
2011年12月27日更新:在线VBScript代码格式化工具VbsBeautifier
因为代码比较长,所以贴在文章的最后,下面是VBS代码格式化工具的效果演示:
格式化前的VBS代码:
复制代码 代码如下:
ON ERROR RESUME NEXT:Set fso = CreateObject("Scripting.FileSystemObject"):X=0:T=true:WhiLe T
Input=Inputbox("Filename Lowercase Batch Convertor"&vbcrlf&vbcrlf& _
"Please input the destination folder name. e.g. C:Webmaster"&vbcrlf&vbcrlf& _
"Note: Do NOT add "" in the end of folder name!","FLowercase Convertor","C:")
iF Input="" then:Msgbox"Folder name is empty!",48,"Error!":T=true:else T=false:end If:wend
Msgbox"All files names of "&Input&" will be converted to lowercase now...",64,"Note"
fold(Input):Msgbox"Done! Total "&X&" file(s) were converted to lowercase.",64,"Done"
sub fold(Path):SET f=fso.GetFolder(Path):Set rf = fso.GetFolder(Path).files:Set fc = f.SubFolders
foR EACh fff in rf:lcf1=LCase(fso.GetAbsolutePathName(fff))
fso.MoveFile fff, lcf1:X=X + 1:next:for EacH f1 in fc:fold(f1)
Set file=fso.GetFolder(f1).files:fOR EACh ff iN file:lcf=LCase(fso.GetAbsolutePathName(ff))
fso.MoveFile ff,lcf:NEXT:NEXT:END sub

格式化后的VBS代码:
On Error Resume NextSet fso = CreateObject("Scripting.FileSystemObject")X = 0T = TrueWhile TInput = InputBox("Filename Lowercase Batch Convertor" & vbCrLf & vbCrLf & _"Please input the destination folder name. e.g. C:Webmaster" & vbCrLf & vbCrLf & _"Note: Do NOT add "" in the end of folder name!","FLowercase Convertor","C:")If Input = "" ThenMsgBox"Folder name is empty!",48,"Error!"T = TrueElse T = FalseEnd IfWEndMsgBox"All files names of " & Input & " will be converted to lowercase now...",64,"Note"fold(Input)MsgBox"Done! Total " & X & " file(s) were converted to lowercase.",64,"Done"Sub fold(Path)Set f = fso.GetFolder(Path)Set rf = fso.GetFolder(Path).filesSet fc = f.SubFoldersFor Each fff In rflcf1 = LCase(fso.GetAbsolutePathName(fff))fso.MoveFile fff, lcf1X = X + 1NextFor Each f1 In fcfold(f1)Set file = fso.GetFolder(f1).filesFor Each ff In filelcf = LCase(fso.GetAbsolutePathName(ff))fso.MoveFile ff,lcfNextNextEnd Sub
VBS代码格式化工具的源码:
Option ExplicitIf WScript.Arguments.Count = 0 ThenMsgBox "请将要格式化的代码文件拖动到这个文件上", vbInformation, "使用方法"WScript.QuitEnd If"作者: Demon"时间: 2011/12/24"链接: http://demon.tw/my-work/vbs-beautifier.html"描述: VBScript 代码格式化工具"注意: "1. 错误的 VBScript 代码不能被正确地格式化"2. 代码中不能含有%[comment]% %[quoted]%等模板标签, 有待改进"3. 由2可知, 该工具不能格式化自身Dim Beautifier, iSet Beautifier = New VbsBeautifierFor Each i In WScript.ArgumentsBeautifier.BeautifyFile iNextMsgBox "代码格式化完成", vbInformation, "提示"Class VbsBeautifier"VbsBeautifier类Private quoted, comments, code, indentsPrivate ReservedWord, BuiltInFunction, BuiltInConstants, VersionInfo"公共方法"格式化字符串Public Function Beautify(ByVal input)code = inputcode = Replace(code, vbCrLf, vbLf)Call GetQuoted()Call GetComments()Call GetErrorHandling()Call ColonToNewLine()Call FixSpaces()Call ReplaceReservedWord()Call InsertIndent()Call FixIndent()Call PutErrorHandling()Call PutComments()Call PutQuoted()code = Replace(code, vbLf, vbCrLf)code = VersionInfo & codeBeautify = codeEnd Function"公共方法"格式化文件Public Function BeautifyFile(ByVal path)Dim fsoSet fso = CreateObject("scripting.filesystemobject")BeautifyFile = Beautify(fso.OpenTextFile(path).ReadAll)"备份文件以免出错fso.GetFile(path).Copy path & ".bak", Truefso.OpenTextFile(path, 2, True).Write(BeautifyFile)End FunctionPrivate Sub Class_Initialize()"保留字ReservedWord = "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 Rem Resume RSet Select Set Shared Single Static Stop Sub Then To True Type TypeOf Until Variant WEnd While With Xor""内置函数BuiltInFunction = "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""内置常量BuiltInConstants = "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""版本信息VersionInfo = Chr(39) & Chr(86) & Chr(98) & Chr(115) & Chr(66) & Chr(101) & Chr(97) & Chr(117) & Chr(116) & Chr(105) & Chr(102) & Chr(105) & Chr(101) & Chr(114) & Chr(32) & Chr(49) & Chr(46) & Chr(48) & Chr(32) & Chr(98) & Chr(121) & Chr(32) & Chr(68) & Chr(101) & Chr(109) & Chr(111) & Chr(110) & Chr(13) & Chr(10) & Chr(39) & Chr(104) & Chr(116) & Chr(116) & Chr(112) & Chr(58) & Chr(47) & Chr(47) & Chr(100) & Chr(101) & Chr(109) & Chr(111) & Chr(110) & Chr(46) & Chr(116) & Chr(119) & Chr(13) & Chr(10)"缩进大小Set indents = CreateObject("scripting.dictionary")indents("if") = 1indents("sub") = 1indents("function") = 1indents("property") = 1indents("for") = 1indents("while") = 1indents("do") = 1indents("for") = 1indents("select") = 1indents("with") = 1indents("class") = 1indents("end") = -1indents("next") = -1indents("loop") = -1indents("wend") = -1End SubPrivate Sub Class_Terminate()"什么也不做End Sub"将字符串替换成%[quoted]%Private Sub GetQuoted()Dim reSet re = New RegExpre.Global = Truere.Pattern = """.*?"""Set quoted = re.Execute(code)code = re.Replace(code, "%[quoted]%")End Sub"将%[quoted]%替换回字符串Private Sub PutQuoted()Dim iFor Each i In quotedcode = Replace(code, "%[quoted]%", i, 1, 1)NextEnd Sub"将注释替换成%[comment]%Private Sub GetComments()Dim reSet re = New RegExpre.Global = Truere.Pattern = "".*"Set comments = re.Execute(code)code = re.Replace(code, "%[comment]%")End Sub"将%[comment]%替换回注释Private Sub PutComments()Dim iFor Each i In commentscode = Replace(code, "%[comment]%", i, 1, 1)NextEnd Sub"将冒号替换成换行Private Sub ColonToNewLinecode = Replace(code, ":", vbLf)End Sub"将错误处理语句替换成模板标签Private Sub GetErrorHandling()Dim reSet re = New RegExpre.Global = Truere.IgnoreCase = Truere.Pattern = "ons+errors+resumes+next"code = re.Replace(code, "%[resumenext]%")re.Pattern = "ons+errors+gotos+0"code = re.Replace(code, "%[gotozero]%")End Sub"将模板标签替换回错误处理语句Private Sub PutErrorHandling()code = Replace(code, "%[resumenext]%", "On Error Resume Next")code = Replace(code, "%[gotozero]%", "On Error GoTo 0")End Sub"格式化空格Private Sub FixSpaces()Dim reSet re = New RegExpre.Global = Truere.IgnoreCase = Truere.MultiLine = True"去掉每行前后的空格re.Pattern = "^[ 	]*(.*?)[ 	]*$"code = re.Replace(code, "$1")"在操作符前后添加空格re.Pattern = "[ 	]*(=|<|>|-|+|&|*|/|^|\)[ 	]*"code = re.Replace(code, " $1 ")"去掉<>中间的空格re.Pattern = "[ 	]*<s*>[ 	]*"code = re.Replace(code, " <> ")"去掉<=中间的空格re.Pattern = "[ 	]*<s*=[ 	]*"code = re.Replace(code, " <= ")"去掉>=中间的空格re.Pattern = "[ 	]*>s*=[ 	]*"code = re.Replace(code, " >= ")"在行尾的 _ 前面加上空格re.Pattern = "[ 	]*_[ 	]*$"code = re.Replace(code, " _")"去掉Do While中间多余的空格re.Pattern = "[ 	]*Dos*While[ 	]*"code = re.Replace(code, "Do While")"去掉Do Until中间多余的空格re.Pattern = "[ 	]*Dos*Until[ 	]*"code = re.Replace(code, "Do Until")"去掉End Sub中间多余的空格re.Pattern = "[ 	]*Ends*Sub[ 	]*"code = re.Replace(code, "End Sub")"去掉End Function中间多余的空格re.Pattern = "[ 	]*Ends*Function[ 	]*"code = re.Replace(code, "End Function")"去掉End If中间多余的空格re.Pattern = "[ 	]*Ends*If[ 	]*"code = re.Replace(code, "End If")"去掉End With中间多余的空格re.Pattern = "[ 	]*Ends*With[ 	]*"code = re.Replace(code, "End With")"去掉End Select中间多余的空格re.Pattern = "[ 	]*Ends*Select[ 	]*"code = re.Replace(code, "End Select")"去掉Select Case中间多余的空格re.Pattern = "[ 	]*Selects*Case[ 	]*"code = re.Replace(code, "Select Case ")End Sub"将保留字 内置函数 内置常量 替换成首字母大写Private Sub ReplaceReservedWord()Dim re, words, wordSet re = New RegExpre.Global = Truere.IgnoreCase = Truere.MultiLine = Truewords = Split(ReservedWord, " ")For Each word In wordsre.Pattern = "()" & word & "()"code = re.Replace(code, "$1" & word & "$2")Nextwords = Split(BuiltInFunction, " ")For Each word In wordsre.Pattern = "()" & word & "()"code = re.Replace(code, "$1" & word & "$2")Nextwords = Split(BuiltInConstants, " ")For Each word In wordsre.Pattern = "()" & word & "()"code = re.Replace(code, "$1" & word & "$2")NextEnd Sub"插入缩进Private Sub InsertIndent()Dim lines, line, i, n, t, deltalines = Split(code, vbLf)n = UBound(lines)For i = 0 To nline = lines(i)SingleLineIfThen linet = deltadelta = delta + CountDelta(line)If t <= delta Thenlines(i) = String(t, vbTab) & lines(i)Elselines(i) = String(delta, vbTab) & lines(i)End IfNextcode = Join(lines, vbLf)End Sub"调整错误的缩进Private Sub FixIndent()Dim lines, i, n, reSet re = New RegExpre.IgnoreCase = Truelines = Split(code, vbLf)n = UBound(lines)For i = 0 To nre.Pattern = "^	*else"If re.Test(lines(i)) Thenlines(i) = Replace(lines(i), vbTab, "", 1, 1)End IfNextcode = Join(lines, vbLf)End Sub"计算缩进大小Private Function CountDelta(ByRef line)Dim i, re, deltaSet re = New RegExpre.Global = Truere.IgnoreCase = TrueFor Each i In indents.Keysre.Pattern = "^s*" & i & ""If re.Test(line) Then"方便调试"WScript.Echo lineline = re.Replace(line, "")delta = delta + indents(i)End IfNextCountDelta = deltaEnd Function"处理单行的If ThenPrivate Sub SingleLineIfThen(ByRef line)Dim reSet re = New RegExpre.IgnoreCase = Truere.Pattern = "if.*?then.+"line = re.Replace(line, "")"去掉Private Public前缀re.Pattern = "(private|public).+?(sub|function|property)"line = re.Replace(line, "$2")End SubEnd Class"Demon, 于2011年平安夜
来源:http://demon.tw/my-work/vbs-beautifier.html