97国产公开视频在线观看,国产精品无码AV中文

主頁 > 知識(shí)庫 > 用VBS寫的VBSCRIPT代碼格式化工具VbsBeautifier

用VBS寫的VBSCRIPT代碼格式化工具VbsBeautifier

昨天在VBS吧看到一個(gè)精華帖《VBS代碼格式化工具》，是用C++寫的，區(qū)區(qū)VBS代碼格式化，就不要?jiǎng)贑++大駕了吧，用VBS實(shí)現(xiàn)VBS代碼格式化工具不是更自然么？

網(wǎng)上的VBS代碼大部分都沒有縮進(jìn)，新手不知道要縮進(jìn)，高手縮進(jìn)了被某些個(gè)垃圾網(wǎng)站采集以后也就沒有了縮進(jìn)，還有以一些博客貼吧也會(huì)把縮進(jìn)給吃掉。除了縮進(jìn)之外，由于學(xué)VBS的大部分都是學(xué)批處理出身，代碼風(fēng)格還是跟寫批處理一樣難看。其實(shí)一般情況下用VbsEdit 5.2.4.0自帶的代碼格式化功能就行了，沒有必要重復(fù)造輪子。只不過VbsEdit 5.2.4.0在格式化帶有冒號(hào)的代碼時(shí)不是很理想，加上我已經(jīng)很久沒有寫過像樣的VBS腳本了，所以還是決定造一下輪子。

2011年12月27日更新：在線VBScript代碼格式化工具VbsBeautifier

因?yàn)榇a比較長(zhǎng)，所以貼在文章的最后，下面是VBS代碼格式化工具的效果演示：

格式化前的VBS代碼：

復(fù)制代碼代碼如下:

ON ERROR RESUME NEXT:Set fso = CreateObject("Scripting.FileSystemObject"):X=0:T=true:WhiLe T

Input=Inputbox("Filename Lowercase Batch Convertor"vbcrlfvbcrlf _

"Please input the destination folder name. e.g. C:\Webmaster"vbcrlfvbcrlf _

"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 "請(qǐng)將要格式化的代碼文件拖動(dòng)到這個(gè)文件上", vbInformation, "使用方法"
  WScript.Quit
End If

'作者: Demon
'時(shí)間: 2011/12/24
'鏈接: http://demon.tw/my-work/vbs-beautifier.html
'描述: VBScript 代碼格式化工具
'注意: 
'1. 錯(cuò)誤的 VBScript 代碼不能被正確地格式化
'2. 代碼中不能含有%[comment]% %[quoted]%等模板標(biāo)簽, 有待改進(jìn)
'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)
    '備份文件以免出錯(cuò)
    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"
    '內(nèi)置函數(shù)
    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"
    '內(nèi)置常量
    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)
    '縮進(jìn)大小
    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

  '將冒號(hào)替換成換行
  Private Sub ColonToNewLine
    code = Replace(code, ":", vbLf)
  End Sub

  '將錯(cuò)誤處理語句替換成模板標(biāo)簽
  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

  '將模板標(biāo)簽替換回錯(cuò)誤處理語句
  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

  '將保留字 內(nèi)置函數(shù) 內(nèi)置常量 替換成首字母大寫
  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

  '插入縮進(jìn)
  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

  '調(diào)整錯(cuò)誤的縮進(jìn)
  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

  '計(jì)算縮進(jìn)大小
  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
        '方便調(diào)試
        '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

標(biāo)簽：邢臺(tái) 鶴壁湖州四平銅川西安 ?？?/a> 文山

巨人網(wǎng)絡(luò)通訊聲明：本文標(biāo)題《用VBS寫的VBSCRIPT代碼格式化工具VbsBeautifier》，本文關(guān)鍵詞用,VBS,寫的,VBSCRIPT,代碼,；如發(fā)現(xiàn)本文內(nèi)容存在版權(quán)問題，煩請(qǐng)?zhí)峁┫嚓P(guān)信息告之我們，我們將及時(shí)溝通與處理。本站內(nèi)容系統(tǒng)采集于網(wǎng)絡(luò)，涉及言論、版權(quán)與本站無關(guān)。