用VBS写的VBSCRIPT代码格式化工具VbsBeautifier
昨天在VBS吧看到一个精华帖《VBS代码格式化工具》，是用C++写的，区区VBS代码格式化，就不要劳C++大驾了吧，用VBS实现VBS代码格式化工具不是更自然么？
网上的VBS代码大部分都没有缩进，新手不知道要缩进，高手缩进了被某些个垃圾网站采集以后也就没有了缩进，还有以一些博客贴吧也会把缩进给吃掉。除了缩进之外，由于学VBS的大部分都是学批处理出身，代码风格还是跟写批处理一样难看。其实一般情况下用VbsEdit5.2.4.0自带的代码格式化功能就行了，没有必要重复造轮子。只不过VbsEdit5.2.4.0在格式化带有冒号的代码时不是很理想，加上我已经很久没有写过像样的VBS脚本了，所以还是决定造一下轮子。
2011年12月27日更新：在线VBScript代码格式化工具VbsBeautifier
因为代码比较长，所以贴在文章的最后，下面是VBS代码格式化工具的效果演示：
格式化前的VBS代码：
ONERRORRESUMENEXT:Setfso=CreateObject("Scripting.FileSystemObject"):X=0:T=true:WhiLeT
Input=Inputbox("FilenameLowercaseBatchConvertor"&vbcrlf&vbcrlf&_
"Pleaseinputthedestinationfoldername.e.g.C:\Webmaster"&vbcrlf&vbcrlf&_
"Note:DoNOTadd'\'intheendoffoldername!","FLowercaseConvertor","C:\")
iFInput=""then:Msgbox"Foldernameisempty!",48,"Error!":T=true:elseT=false:endIf:wend
Msgbox"Allfilesnamesof"&Input&"willbeconvertedtolowercasenow...",64,"Note"
fold(Input):Msgbox"Done!Total"&X&"file(s)wereconvertedtolowercase.",64,"Done"
subfold(Path):SETf=fso.GetFolder(Path):Setrf=fso.GetFolder(Path).files:Setfc=f.SubFolders
foREAChfffinrf:lcf1=LCase(fso.GetAbsolutePathName(fff))
fso.MoveFilefff,lcf1:X=X+1:next:forEacHf1infc:fold(f1)
Setfile=fso.GetFolder(f1).files:fOREAChffiNfile:lcf=LCase(fso.GetAbsolutePathName(ff))
fso.MoveFileff,lcf:NEXT:NEXT:ENDsub
格式化后的VBS代码：
OnErrorResumeNext
Setfso=CreateObject("Scripting.FileSystemObject")
X=0
T=True
WhileT
Input=InputBox("FilenameLowercaseBatchConvertor"&vbCrLf&vbCrLf&_
"Pleaseinputthedestinationfoldername.e.g.C:\Webmaster"&vbCrLf&vbCrLf&_
"Note:DoNOTadd'\'intheendoffoldername!","FLowercaseConvertor","C:\")
IfInput=""Then
MsgBox"Foldernameisempty!",48,"Error!"
T=True
ElseT=False
EndIf
WEnd
MsgBox"Allfilesnamesof"&Input&"willbeconvertedtolowercasenow...",64,"Note"
fold(Input)
MsgBox"Done!Total"&X&"file(s)wereconvertedtolowercase.",64,"Done"
Subfold(Path)
Setf=fso.GetFolder(Path)
Setrf=fso.GetFolder(Path).files
Setfc=f.SubFolders
ForEachfffInrf
lcf1=LCase(fso.GetAbsolutePathName(fff))
fso.MoveFilefff,lcf1
X=X+1
Next
ForEachf1Infc
fold(f1)
Setfile=fso.GetFolder(f1).files
ForEachffInfile
lcf=LCase(fso.GetAbsolutePathName(ff))
fso.MoveFileff,lcf
Next
Next
EndSub
VBS代码格式化工具的源码：
OptionExplicit
IfWScript.Arguments.Count=0Then
MsgBox"请将要格式化的代码文件拖动到这个文件上",vbInformation,"使用方法"
WScript.Quit
EndIf
'作者:Demon
'时间:2011/12/24
'链接:http://demon.tw/my-work/vbs-beautifier.html
'描述:VBScript代码格式化工具
'注意:
'1.错误的VBScript代码不能被正确地格式化
'2.代码中不能含有%[comment]%%[quoted]%等模板标签,有待改进
'3.由2可知,该工具不能格式化自身
DimBeautifier,i
SetBeautifier=NewVbsBeautifier
ForEachiInWScript.Arguments
Beautifier.BeautifyFilei
Next
MsgBox"代码格式化完成",vbInformation,"提示"
ClassVbsBeautifier
'VbsBeautifier类
Privatequoted,comments,code,indents
PrivateReservedWord,BuiltInFunction,BuiltInConstants,VersionInfo
'公共方法
'格式化字符串
PublicFunctionBeautify(ByValinput)
code=input
code=Replace(code,vbCrLf,vbLf)
CallGetQuoted()
CallGetComments()
CallGetErrorHandling()
CallColonToNewLine()
CallFixSpaces()
CallReplaceReservedWord()
CallInsertIndent()
CallFixIndent()
CallPutErrorHandling()
CallPutComments()
CallPutQuoted()
code=Replace(code,vbLf,vbCrLf)
code=VersionInfo&code
Beautify=code
EndFunction
'公共方法
'格式化文件
PublicFunctionBeautifyFile(ByValpath)
Dimfso
Setfso=CreateObject("scripting.filesystemobject")
BeautifyFile=Beautify(fso.OpenTextFile(path).ReadAll)
'备份文件以免出错
fso.GetFile(path).Copypath&".bak",True
fso.OpenTextFile(path,2,True).Write(BeautifyFile)
EndFunction
PrivateSubClass_Initialize()
'保留字
ReservedWord="AndAsBooleanByRefByteByValCallCaseClassConstCurrencyDebugDimDoDoubleEachElseElseIfEmptyEndEndIfEnumEqvEventExitExplicitFalseForFunctionGetGotoIfImpImplementsInIntegerIsLetLikeLongLoopLSetMeModNewNextNotNothingNullOnOptionOptionalOrParamArrayPreservePrivatePropertyPublicRaiseEventReDimRemResumeRSetSelectSetSharedSingleStaticStopSubThenToTrueTypeTypeOfUntilVariantWEndWhileWithXor"
'内置函数
BuiltInFunction="AbsArrayAscAtnCBoolCByteCCurCDateCDblCIntCLngCSngCStrChrCosCreateObjectDateDateAddDateDiffDatePartDateSerialDateValueDayEscapeEvalExpFilterFixFormatCurrencyFormatDateTimeFormatNumberFormatPercentGetLocaleGetObjectGetRefHexHourInStrInStrRevInputBoxIntIsArrayIsDateIsEmptyIsNullIsNumericIsObjectJoinLBoundLCaseLTrimLeftLenLoadPictureLogMidMinuteMonthMonthNameMsgBoxNowOctRandomizeRGBRTrimReplaceRightRndRoundScriptEngineScriptEngineBuildVersionScriptEngineMajorVersionScriptEngineMinorVersionSecondSetLocaleSgnSinSpaceSplitSqrStrCompStrReverseStringTanTimeTimeSerialTimeValueTimerTrimTypeNameUBoundUCaseUnescapeVarTypeWeekdayWeekdayNameYear"
'内置常量
BuiltInConstants="vbBlackvbRedvbGreenvbYellowvbBluevbMagentavbCyanvbWhitevbBinaryComparevbTextComparevbSundayvbMondayvbTuesdayvbWednesdayvbThursdayvbFridayvbSaturdayvbUseSystemDayOfWeekvbFirstJan1vbFirstFourDaysvbFirstFullWeekvbGeneralDatevbLongDatevbShortDatevbLongTimevbShortTimevbObjectErrorvbOKOnlyvbOKCancelvbAbortRetryIgnorevbYesNoCancelvbYesNovbRetryCancelvbCriticalvbQuestionvbExclamationvbInformationvbDefaultButton1vbDefaultButton2vbDefaultButton3vbDefaultButton4vbApplicationModalvbSystemModalvbOKvbCancelvbAbortvbRetryvbIgnorevbYesvbNovbCrvbCrLfvbFormFeedvbLfvbNewLinevbNullCharvbNullStringvbTabvbVerticalTabvbUseDefaultvbTruevbFalsevbEmptyvbNullvbIntegervbLongvbSinglevbDoublevbCurrencyvbDatevbStringvbObjectvbErrorvbBooleanvbVariantvbDataObjectvbDecimalvbBytevbArrayWScript"
'版本信息
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)
'缩进大小
Setindents=CreateObject("scripting.dictionary")
indents("if")=1
indents("sub")=1
indents("function")=1
indents("property")=1
indents("for")=1
indents("while")=1
indents("do")=1
indents("for")=1
indents("select")=1
indents("with")=1
indents("class")=1
indents("end")=-1
indents("next")=-1
indents("loop")=-1
indents("wend")=-1
EndSub
PrivateSubClass_Terminate()
'什么也不做
EndSub
'将字符串替换成%[quoted]%
PrivateSubGetQuoted()
Dimre
Setre=NewRegExp
re.Global=True
re.Pattern=""".*?"""
Setquoted=re.Execute(code)
code=re.Replace(code,"%[quoted]%")
EndSub
'将%[quoted]%替换回字符串
PrivateSubPutQuoted()
Dimi
ForEachiInquoted
code=Replace(code,"%[quoted]%",i,1,1)
Next
EndSub
'将注释替换成%[comment]%
PrivateSubGetComments()
Dimre
Setre=NewRegExp
re.Global=True
re.Pattern="'.*"
Setcomments=re.Execute(code)
code=re.Replace(code,"%[comment]%")
EndSub
'将%[comment]%替换回注释
PrivateSubPutComments()
Dimi
ForEachiIncomments
code=Replace(code,"%[comment]%",i,1,1)
Next
EndSub
'将冒号替换成换行
PrivateSubColonToNewLine
code=Replace(code,":",vbLf)
EndSub
'将错误处理语句替换成模板标签
PrivateSubGetErrorHandling()
Dimre
Setre=NewRegExp
re.Global=True
re.IgnoreCase=True
re.Pattern="on\s+error\s+resume\s+next"
code=re.Replace(code,"%[resumenext]%")
re.Pattern="on\s+error\s+goto\s+0"
code=re.Replace(code,"%[gotozero]%")
EndSub
'将模板标签替换回错误处理语句
PrivateSubPutErrorHandling()
code=Replace(code,"%[resumenext]%","OnErrorResumeNext")
code=Replace(code,"%[gotozero]%","OnErrorGoTo0")
EndSub
'格式化空格
PrivateSubFixSpaces()
Dimre
Setre=NewRegExp
re.Global=True
re.IgnoreCase=True
re.MultiLine=True
'去掉每行前后的空格
re.Pattern="^[\t]*(.*?)[\t]*$"
code=re.Replace(code,"$1")
'在操作符前后添加空格
re.Pattern="[\t]*(=|<|>|-|\+|&|\*|/|\^|\\)[\t]*"
code=re.Replace(code,"$1")
'去掉<>中间的空格
re.Pattern="[\t]*<\s*>[\t]*"
code=re.Replace(code,"<>")
'去掉<=中间的空格
re.Pattern="[\t]*<\s*=[\t]*"
code=re.Replace(code,"<=")
'去掉>=中间的空格
re.Pattern="[\t]*>\s*=[\t]*"
code=re.Replace(code,">=")
'在行尾的_前面加上空格
re.Pattern="[\t]*_[\t]*$"
code=re.Replace(code,"_")
'去掉DoWhile中间多余的空格
re.Pattern="[\t]*Do\s*While[\t]*"
code=re.Replace(code,"DoWhile")
'去掉DoUntil中间多余的空格
re.Pattern="[\t]*Do\s*Until[\t]*"
code=re.Replace(code,"DoUntil")
'去掉EndSub中间多余的空格
re.Pattern="[\t]*End\s*Sub[\t]*"
code=re.Replace(code,"EndSub")
'去掉EndFunction中间多余的空格
re.Pattern="[\t]*End\s*Function[\t]*"
code=re.Replace(code,"EndFunction")
'去掉EndIf中间多余的空格
re.Pattern="[\t]*End\s*If[\t]*"
code=re.Replace(code,"EndIf")
'去掉EndWith中间多余的空格
re.Pattern="[\t]*End\s*With[\t]*"
code=re.Replace(code,"EndWith")
'去掉EndSelect中间多余的空格
re.Pattern="[\t]*End\s*Select[\t]*"
code=re.Replace(code,"EndSelect")
'去掉SelectCase中间多余的空格
re.Pattern="[\t]*Select\s*Case[\t]*"
code=re.Replace(code,"SelectCase")
EndSub
'将保留字内置函数内置常量替换成首字母大写
PrivateSubReplaceReservedWord()
Dimre,words,word
Setre=NewRegExp
re.Global=True
re.IgnoreCase=True
re.MultiLine=True
words=Split(ReservedWord,"")
ForEachwordInwords
re.Pattern="(\b)"&word&"(\b)"
code=re.Replace(code,"$1"&word&"$2")
Next
words=Split(BuiltInFunction,"")
ForEachwordInwords
re.Pattern="(\b)"&word&"(\b)"
code=re.Replace(code,"$1"&word&"$2")
Next
words=Split(BuiltInConstants,"")
ForEachwordInwords
re.Pattern="(\b)"&word&"(\b)"
code=re.Replace(code,"$1"&word&"$2")
Next
EndSub
'插入缩进
PrivateSubInsertIndent()
Dimlines,line,i,n,t,delta
lines=Split(code,vbLf)
n=UBound(lines)
Fori=0Ton
line=lines(i)
SingleLineIfThenline
t=delta
delta=delta+CountDelta(line)
Ift<=deltaThen
lines(i)=String(t,vbTab)&lines(i)
Else
lines(i)=String(delta,vbTab)&lines(i)
EndIf
Next
code=Join(lines,vbLf)
EndSub
'调整错误的缩进
PrivateSubFixIndent()
Dimlines,i,n,re
Setre=NewRegExp
re.IgnoreCase=True
lines=Split(code,vbLf)
n=UBound(lines)
Fori=0Ton
re.Pattern="^\t*else"
Ifre.Test(lines(i))Then
lines(i)=Replace(lines(i),vbTab,"",1,1)
EndIf
Next
code=Join(lines,vbLf)
EndSub
'计算缩进大小
PrivateFunctionCountDelta(ByRefline)
Dimi,re,delta
Setre=NewRegExp
re.Global=True
re.IgnoreCase=True
ForEachiInindents.Keys
re.Pattern="^\s*\b"&i&"\b"
Ifre.Test(line)Then
'方便调试
'WScript.Echoline
line=re.Replace(line,"")
delta=delta+indents(i)
EndIf
Next
CountDelta=delta
EndFunction
'处理单行的IfThen
PrivateSubSingleLineIfThen(ByRefline)
Dimre
Setre=NewRegExp
re.IgnoreCase=True
re.Pattern="if.*?then.+"
line=re.Replace(line,"")
'去掉PrivatePublic前缀
re.Pattern="(private|public).+?(sub|function|property)"
line=re.Replace(line,"$2")
EndSub
EndClass
'Demon,于2011年平安夜
来源：http://demon.tw/my-work/vbs-beautifier.html