On Error Resume NextSet fso = CreateObject("Scripting.FileSystemObject")X = 0T = TrueWhile 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 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).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  NextEnd Sub

Option ExplicitIf WScript.Arguments.Count = 0 Then  MsgBox "請將要格式化的代碼文件拖動到這個文件上", 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.Arguments  Beautifier.BeautifyFile iNextMsgBox "代碼格式化完成", 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 SubEnd Class'Demon, 于2011年平安夜