用VBS写的VBSCRIPT代码格式化工具VbsBeautifier_vbs

昨天在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 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代码格式化工具的源码：

Option Explicit

If WScript.Arguments.Count = 0 Then
  MsgBox "请将要格式化的代码文件拖动到这个文件上", vbInformation, "使用方法"
  WScript.Quit
End If

'作者: Demon
'时间: 2011/12/24
'链接: http://demon.tw/my-work/vbs-beautifier.html
'描述: VBScript 代码格式化工具
'注意:
'1. 错误的 VBScript 代码不能被正确地格式化
'2. 代码中不能含有%[comment]% %[quoted]%等模板标签, 有待改进
'3. 由2可知, 该工具不能格式化自身

Dim Beautifier, i
Set Beautifier = New VbsBeautifier

For Each i In WScript.Arguments
  Beautifier.BeautifyFile i
Next

MsgBox "代码格式化完成", vbInformation, "提示"

Class VbsBeautifier
  'VbsBeautifier类

  Private quoted, comments, code, indents
  Private ReservedWord, BuiltInFunction, BuiltInConstants, VersionInfo

  '公共方法
  '格式化字符串
  Public Function Beautify(ByVal input)
    code = input
    code = 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 & code
    Beautify = code
  End Function

  '公共方法
  '格式化文件
  Public Function BeautifyFile(ByVal path)
    Dim fso
    Set fso = CreateObject("scripting.filesystemobject")
    BeautifyFile = Beautify(fso.OpenTextFile(path).ReadAll)
    '备份文件以免出错
    fso.GetFile(path).Copy path & ".bak", True
    fso.OpenTextFile(path, 2, True).Write(BeautifyFile)
  End Function

  Private 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") = 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
  End Sub

  Private Sub Class_Terminate()
    '什么也不做
  End Sub

  '将字符串替换成%[quoted]%
  Private Sub GetQuoted()
    Dim re
    Set re = New RegExp
    re.Global = True
    re.Pattern = """.*?"""
    Set quoted = re.Execute(code)
    code = re.Replace(code, "%[quoted]%")
  End Sub

  '将%[quoted]%替换回字符串
  Private Sub PutQuoted()
    Dim i
    For Each i In quoted
      code = Replace(code, "%[quoted]%", i, 1, 1)
    Next
  End Sub

  '将注释替换成%[comment]%
  Private Sub GetComments()
    Dim re
    Set re = New RegExp
    re.Global = True
    re.Pattern = "'.*"
    Set comments = re.Execute(code)
    code = re.Replace(code, "%[comment]%")
  End Sub

  '将%[comment]%替换回注释
  Private Sub PutComments()
    Dim i
    For Each i In comments
      code = Replace(code, "%[comment]%", i, 1, 1)
    Next
  End Sub

  '将冒号替换成换行
  Private Sub ColonToNewLine
    code = Replace(code, ":", vbLf)
  End Sub

  '将错误处理语句替换成模板标签
  Private Sub GetErrorHandling()
    Dim re
    Set re = New RegExp
    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]%")
  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 re
    Set re = New RegExp
    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, " _")
    '去掉Do While中间多余的空格
    re.Pattern = "[ \t]*Do\s*While[ \t]*"
    code = re.Replace(code, "Do While")
    '去掉Do Until中间多余的空格
    re.Pattern = "[ \t]*Do\s*Until[ \t]*"
    code = re.Replace(code, "Do Until")
    '去掉End Sub中间多余的空格
    re.Pattern = "[ \t]*End\s*Sub[ \t]*"
    code = re.Replace(code, "End Sub")
    '去掉End Function中间多余的空格
    re.Pattern = "[ \t]*End\s*Function[ \t]*"
    code = re.Replace(code, "End Function")
    '去掉End If中间多余的空格
    re.Pattern = "[ \t]*End\s*If[ \t]*"
    code = re.Replace(code, "End If")
    '去掉End With中间多余的空格
    re.Pattern = "[ \t]*End\s*With[ \t]*"
    code = re.Replace(code, "End With")
    '去掉End Select中间多余的空格
    re.Pattern = "[ \t]*End\s*Select[ \t]*"
    code = re.Replace(code, "End Select")
    '去掉Select Case中间多余的空格
    re.Pattern = "[ \t]*Select\s*Case[ \t]*"
    code = re.Replace(code, "Select Case ")
  End Sub

  '将保留字 内置函数 内置常量 替换成首字母大写
  Private Sub ReplaceReservedWord()
    Dim re, words, word
    Set re = New RegExp
    re.Global = True
    re.IgnoreCase = True
    re.MultiLine = True

    words = Split(ReservedWord, " ")
    For Each word In words
      re.Pattern = "(\b)" & word & "(\b)"
      code = re.Replace(code, "$1" & word & "$2")
    Next

    words = Split(BuiltInFunction, " ")
    For Each word In words
      re.Pattern = "(\b)" & word & "(\b)"
      code = re.Replace(code, "$1" & word & "$2")
    Next

    words = Split(BuiltInConstants, " ")
    For Each word In words
      re.Pattern = "(\b)" & word & "(\b)"
      code = re.Replace(code, "$1" & word & "$2")
    Next
  End Sub

  '插入缩进
  Private Sub InsertIndent()
    Dim lines, line, i, n, t, delta
    lines = Split(code, vbLf)
    n = UBound(lines)
    For i = 0 To n
      line = lines(i)
      SingleLineIfThen line
      t = delta
      delta = delta + CountDelta(line)

      If t <= delta Then
        lines(i) = String(t, vbTab) & lines(i)
      Else
        lines(i) = String(delta, vbTab) & lines(i)
      End If
    Next
    code = Join(lines, vbLf)
  End Sub

  '调整错误的缩进
  Private Sub FixIndent()
    Dim lines, i, n, re
    Set re = New RegExp
    re.IgnoreCase = True
    lines = Split(code, vbLf)
    n = UBound(lines)
    For i = 0 To n
      re.Pattern = "^\t*else"
      If re.Test(lines(i)) Then
        lines(i) = Replace(lines(i), vbTab, "", 1, 1)
      End If
    Next
    code = Join(lines, vbLf)
  End Sub

  '计算缩进大小
  Private Function CountDelta(ByRef line)
    Dim i, re, delta
    Set re = New RegExp
    re.Global = True
    re.IgnoreCase = True
    For Each i In indents.Keys
      re.Pattern = "^\s*\b" & i & "\b"
      If re.Test(line) Then
        '方便调试
        'WScript.Echo line
        line = re.Replace(line, "")
        delta = delta + indents(i)
      End If
    Next
    CountDelta = delta
  End Function

  '处理单行的If Then
  Private Sub SingleLineIfThen(ByRef line)
    Dim re
    Set re = New RegExp
    re.IgnoreCase = True
    re.Pattern = "if.*?then.+"
    line = re.Replace(line, "")
    '去掉Private Public前缀
    re.Pattern = "(private|public).+?(sub|function|property)"
    line = re.Replace(line, "$2")
  End Sub

End Class
'Demon, 于2011年平安夜

来源：http://demon.tw/my-work/vbs-beautifier.html

以上是小编为您精心准备的的内容，在的博客、问答、公众号、人物、课程等栏目也有的相关内容，欢迎继续使用右上角搜索按钮进行搜索vbs代码格式化
vbscript 格式化日期、vbs格式化、vbs 格式化字符串、vbs 格式化日期、vbs格式化时间，以便于您获取更多的相关知识。

时间： 2024-09-20 06:04:05

用VBS写的VBSCRIPT代码格式化工具VbsBeautifier_vbs的相关文章

VBScript基础教程之二在HTML页面中添加VBscript代码

vbscript|基础教程|页面 SCRIPT 元素用于将 VBScript 代码添加到 HTML 页面中. <SCRIPT> 标记 VBScript 代码写在成对的 <SCRIPT> 标记之间.例如,以下代码为一个测试传递日期的过程: <SCRIPT LANGUAGE="VBScript"> <!-- Function CanDeliver(Dt) CanDeliver = (CDate(Dt) - Now()) > 2 End Fun

在 HTML 页面中添加 VBScript 代码

vbscript|页面 SCRIPT 元素用于将 VBScript 代码添加到 HTML 页面中. <SCRIPT> 标记 VBScript 代码写在成对的 <SCRIPT> 标记之间.例如,以下代码为一个测试传递日期的过程: <SCRIPT LANGUAGE="VBScript"> <!-- Function CanDeliver(Dt) CanDeliver = (CDate(Dt) - Now()) > 2 End Function

Notepad++插件JSTool：JS代码格式化工具

  Notepad++插件JSTool:JS代码格式化工具         我们在写Js的时候,经常需要格式化Js代码,这个时候就可以试下这款插件:JsToolNpp(以前也叫:JsMin),针对Js文件格式化效果很好,强烈推荐. 下载插件 插件 > Plugin Manager > Show Plugin Manager jstoolnpp install 安装插件 找到JsTool,选中,然后点击Install按钮,自动下载安装,重启Notepad++ 使用插件 在插件选项里面会多出一个J

VBS中常用脚本代码_vbs

将域用户或租添加到本地组 Set objGroup = GetObject("WinNT://./Administrators") Set objUser = GetObject("WinNT://testnet/Engineers") objGroup.Add(objUser.ADsPath) 修改本地管理员密码 Set objcnlar = GetObject("WinNT://./administrator, user") objcnla.

PHP,ASP.JAVA,JAVA代码格式化工具整理_php技巧

PHP代码格式化工具http://www.waterproof.fr/products/phpCodeBeautifier/最近修改一个代码,里面完全没有缩进,用这个能够格式化一下.相当于以前c 的indent顺便写一下其他语言的c, c++ c# ==> indent Astylejava ==> astyle Jalopy Jacobe ImportScrbberphp ==> phpCodeBeautifierperl ==> perlTidypython ==> Py

VBS教程：VBScript 页面的简单样例_vbs

VBScript 页面的简单样例 一个简单页面 使用 Microsoft(R) Internet Explorer 可以查看用以下 HTML 代码制作的页面.如果单击页面上的按钮,可看到 VBScript 的运行结果. <HTML><HEAD><TITLE>一个简单首页</TITLE><SCRIPT LANGUAGE="VBScript"><!--Sub Button1_onClick MsgBox "Hell

VBS教程：VBScript 基础-VBScript编码约定_vbs

VBScript编码约定 编码约定是帮助您使用 Microsoft Visual Basic Scripting Edition 编写代码的一些建议.编码约定包含以下内容: 对象.变量和过程的命名约定 注释约定 文本格式和缩进指南 使用一致的编码约定的主要原因是使脚本或脚本集的结构和编码样式标准化,这样代码易于阅读和理解.使用好的编码约定可以使源代码明白.易读.准确,更加直观且与其他语言约定保持一致. 常数命名约定 VBScript 的早期版本不允许创建用户自定义常数.如果要使用常数,则常数以变

VBScript教程 第二课在HTML页面中添加VBscript代码_vbs

VB教程 > 第二课在HTML页面中添加VBscript代码 SCRIPT 元素用于将 VBScript 代码添加到 HTML 页面中. <SCRIPT> 标记 VBScript 代码写在成对的 <SCRIPT> 标记之间.例如,以下代码为一个测试传递日期的过程: <SCRIPT LANGUAGE="VBScript"> <!--Function CanDeliver(Dt)CanDeliver = (CDate(Dt) - Now())

VBS教程：VBScript 基础-使用条件语句_vbs

使用条件语句 控制程序执行 使用条件语句和循环语句可以控制脚本的流程.使用条件语句可以编写进行判断和重复操作的 VBScript 代码.在 VBScript 中可使用以下条件语句: If...Then...Else 语句 Select Case 语句 使用 If...Then...Else 进行判断 If...Then...Else 语句用于计算条件是否为 True 或 False,并且根据计算结果指定要运行的语句.通常,条件是使用比较运算符对值或变量进行比较的表达式.有关比较运算符的详细信息,