VBSで書かれたVBSCRITTコードフォーマットツールVbsBeautifier
15845 ワード
昨日VBSバーで1つの精华の帖《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コード:
フォーマットされたVBSコード:
VBSコードフォーマットツールのソース:
ソース:http://demon.tw/my-work/vbs-beautifier.html
ネット上の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]*[ \t]*"
code = re.Replace(code, " <> ")
' <=
re.Pattern = "[ \t]*=
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