VBScript code formatting tool written with VBS VBSBEAUTIFIER_VBS

Yesterday in the VBS bar to see a essence of the "VBS code format Tool", is written in C + +, a district of the VBS code format, do not Labor C + + to the bar, with the VBS implementation of the VBS code format tool is not more natural?

The online VBS most of the code is not indented, the novice does not know to indent, the master indent by some garbage site after the collection is not indented, and some blog bar will also be indented to eat. In addition to indentation, because most of the learning VBS is a batch process, the code style is just as ugly as the write batch process. In fact, in general, the Vbsedit 5.2.4.0 with the code formatting function on the line, there is no need to repeat the wheel. It's just that Vbsedit 5.2.4.0 is not ideal when formatting code with colons, plus I haven't written a decent VBS script in a long time, so I decided to build a wheel.

December 27, 2011 Update: Online VBScript code formatting tool Vbsbeautifier

Because the code is relatively long, so posted at the end of the article, the following is the VBS Code formatting tool effect Demo:

The VBS code before formatting:

Copy Code code as follows:

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 '" "," name! "," Flowercase convertor "," C:\ ")
IF input= "" Then:msgbox "folder name is empty!", "error!": T=true:else t=false:end
Msgbox "All Files Names of" &Input& "would be converted to lowercase now ...", "note"
Fold (Input): Msgbox "done! Total ' &X& ' file (s) were converted to lowercase. "
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

The formatted VBS code:

On Error Resume Next Set fso = CreateObject ("Scripting.FileSystemObject") X = 0 T = True while T Input = InputBox ("File Name lowercase Batch convertor "& VbCrLf & vbCrLf & _" Please input the destination folder name. e.g. C:\Webmaster "& VbCrLf & VbCrLf & _" Note:do not add ' "," "", "", "", "", ", name! flowercase
    Rtor "," C:\ ") If Input =" "Then MsgBox" folder name is empty! "," error! " t = True Else t = False end If wend MsgBox "All Files Names of" & Input & "would be converted to lowercase now ... ",", "note" fold (Input) MsgBox "done! Total ' & X & ' file (s) were converted to lowercase. ", $," 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 all 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 code Format tool source code:

Option Explicit If WScript.Arguments.Count = 0 Then MsgBox "Please drag the formatted code file onto this file," vbinformation, "use Method" Wscript.Quit End If ' Author: Demon ' time: 2011/12/24 ' link: http://demon.tw/my-work/vbs-beautifier.html ' Description: VBScript code formatting tool ' NOTE: ' 1. Wrong V Bscript code cannot be properly formatted ' 2. The code can not contain%[comment]%%[quoted]% and other template tags, to be improved ' 3. By 2, the tool cannot format itself Dim beautifier, i Set beautifier = New vbsbeautifier for each i in WScript.Arguments Beautifier.beaut  Ifyfile i Next MsgBox "code formatting Complete", vbinformation, "Hint" Class Vbsbeautifier ' Vbsbeautifier class Private quoted, comments,  Code, indents Private Reservedword, Builtinfunction, builtinconstants, Versioninfo ' Common methods ' format string 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 Inse Rtindent () call Fixindent () call puterrorhandling () call PutcommEnts () call putquoted () code = Replace (code, VBLF, vbCrLf) code = versioninfo & Code beautify = Code End Function ' Common method ' format file public Function beautifyfile (ByVal path) Dim FSO Set fso = CreateObject ("Script Ing.filesystemobject ") Beautifyfile = Beautify (fso. OpenTextFile (Path). ReadAll) ' backup file to avoid error FSO. GetFile (Path). Copy path & ". Bak", True fso. OpenTextFile (Path, 2, True). Write (beautifyfile) End Function Private Sub class_initialize () ' reserved word Reservedword = ' and as Boolean ByRef byt E ByVal call case Class Const Currency Debug Dim do Double all Else ElseIf Empty end EndIf Enum Eqv Event Exit Explicit F Alse for Function get Goto If Imp Implements in Integer are let you like Long Loop LSet Me Mod New Next does nothing Null on Opt Ion Optional Or ParamArray Preserve Private Property public RaiseEvent ReDim Rem Resume RSet Select Set Shared single Stat
  IC Stop Sub Then to True Type TypeOf Until Variant wend while with Xor "' built-in function  Builtinfunction = "Abs Array Asc Atn cbool cbyte CCur CDate CDbl CInt CLng csng CStr Chr Cos CreateObject Date DateAdd D Atediff DatePart DateSerial DateValue Day Escape Eval Exp Filter Fix formatcurrency formatdatetime FormatNumber ENT getlocale GetObject GetRef Hex Hour InStr instrrev InputBox Int isarray IsDate isempty IsNull isnumeric Join LBound LCase LTrim left Len loadpicture Log Mid Minute Month monthname MsgBox now Oct Randomize RGB RTrim Replace right Rn D Round scriptengine scriptenginebuildversion scriptenginemajorversion scriptengineminorversion Second SetLocale Sgn Sin spaces Split Sqr strcomp strreverse String Tan time timeserial timevalue Timer Trim TypeName UBound UCase unescape Vart Ype weekday weekdayname Year "' Built-in constants builtinconstants =" Vbblack vbred vbgreen vbyellow, vbblue vbmagenta VbCyan VbW Hite 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 vbUs EDefault vbtrue vbfalse vbempty vbnull vbinteger vblong vbsingle vbdouble vbcurrency vbDate vbString vbObject vbError vbBo Olean vbvariant vbdataobject vbdecimal vbbyte vbarray WScript "' Version information Versioninfo = CHR (a) & Chr (km) & CHR  (& Chr) & Chr & Chr (a) & Chr () & CHR (117) & CHR (116) & Chr (102) & CHR & Chr & Chr (a) & Chr (114) & CHR (+) & Chr (a) & Chr (+) & Chr (a) & Chr (+) & CHR & CHR (121) & Chr (km) & CHR (in) & Chr (a) & Chr (109) & Chr (a) & Chr (a) & Chr (a) & Chr (a) & Chr (km) & CHR () & Chr ( 116) & Chr (116) & Chr (112) & Chr (M) & Chr (All) & Chr ($) & Chr (M) & CHR (109) & Chr & Chr (a) & Chr (+) & Chr (116) & CHR (119) & Chr (a) & Chr (10) ' Indent size Set in
    Dents = CreateObject ("Scripting.Dictionary") indents ("if") = 1 indents ("sub") = 1 indents ("function") = 1 Indents ("property") = 1 indents (' for ') = 1 indents ("while") = 1 indents ("does") = 1 indents ("for") = 1 I
    Ndents ("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 () ' Do not do End Sub ' to replace string with %[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 ' replaces%[quoted]% with the string Private Sub putquoted () Dim I for each i in quoted
    Code = replace (code, "%[quoted]%", I, 1, 1) Next end Sub ' replaces annotations with%[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 ' replaces%[comment]% with annotations Private Sub putcomments () Dim I for each i in Comme NTS code = replace (code, "%[comment]%", I, 1, 1) Next end Sub ' replaces a colon with a newline Private Sub Colontonewline Co de = replace (code, ":", vblf) end Sub ' replaces error-handling statements with template tags Private Sub geterrorhandling () Dim re Set re = New re Gexp 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 ' willTemplate Label replace error handling statement Private Sub puterrorhandling () code = replace (code, "%[resumenext]%", "On Error Resume Next") code = Replace (Code, "%[gotozero]%", "on Error GoTo 0") end Sub ' format space Private Sub fixspaces () Dim re Set re = New RegExp Re. Global = True Re. IgnoreCase = True Re. MultiLine = True ' Removes the space re before and after each line. Pattern = "^[\t]*" (. *?) [\t]*$] Code = Re. Replace (Code, "$") ' adds a space re before and after the operator. pattern = "[\t]* (=|<|>|-|\+|&|\*|/|\^|\\) [\t]*" code = Re. Replace (Code, "$") ' Remove the space re in the middle of the <>. pattern = "[\t]*<\s*>[\t]*" code = Re. Replace (Code, "<>") ' Remove the space re in the middle of the <=. pattern = "[\t]*<\s*=[\t]*" code = Re. Replace (Code, "<=") ' Remove the space re in the middle of the >=. pattern = "[\t]*>\s*=[\t]*" code = Re. Replace (Code, ">=") ' At the end of the _ plus the space re. pattern = "[\t]*_[\t]*$" code = Re. Replace (Code, "_") ' Removes the extra space re in the middle of do. pattern = "[\t]*do\s*while[\t]*" code = Re. RePlace (code, "does while") ' Removes the extra space re in the middle of Do until. pattern = "[\t]*do\s*until[\t]*" code = Re. Replace (Code, "Do Until") ' Removes the extra space re in the middle of the End Sub. pattern = "[\t]*end\s*sub[\t]*" code = Re. Replace (Code, "End Sub") ' Removes the extra space re in the middle of the end function. pattern = "[\t]*end\s*function[\t]*" code = Re. Replace (Code, "End Function") ' Removes the extra space re in the middle of the end If. pattern = "[\t]*end\s*if[\t]*" code = Re. Replace (Code, "End If") ' Removes the extra space re from the end with the middle. pattern = "[\t]*end\s*with[\t]*" code = Re. Replace (Code, "End With") ' Removes the extra space re in the middle of the end Select. pattern = "[\t]*end\s*select[\t]*" code = Re. Replace (Code, "End Select") ' Removes the extra space re in the middle of the Select case. pattern = "[\t]*select\s*case[\t]*" code = Re.  Replace (code, "Select Case") End Sub ' replaces the built-in constants of reserved word built-in functions with the first letter uppercase 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, "$" & Word & "$") Next words = Split (Builtinfunction, "") for each word in words Re. Pattern = "(\b)" & Word & "(\b)" code = Re.
      Replace (Code, "$" & Word & "$") Next words = Split (builtinconstants, "") for each word in words Re. Pattern = "(\b)" & Word & "(\b)" code = Re.  Replace (Code, "$" & Word & "$") Next end Sub ' Insert indent 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) singleline Ifthen 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 ' Adjusts the indentation of the errorInto 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, VbL f) End Sub ' Compute indent size 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 ' easy to debug ' wscript.echo line = Re. Replace (line, "") Delta = Delta + indents (i) end If Next countdelta = Delta End Function ' process single If Then Private Sub singlelineifthen (ByRef line) Dim re Set re = New RegExp re. IgnoreCase = True Re. Pattern = "if.*?then.+" line = Re. Replace (line, "") ' Remove the private public prefix re. Pattern = "(private|public). +? (sub|function|property) "line = Re. Replace (line, "$") End Sub end Class ' Demon, Christmas Eve, 2011

Source: http://demon.tw/my-work/vbs-beautifier.html