国产探花免费观看_亚洲丰满少妇自慰呻吟_97日韩有码在线_资源在线日韩欧美_一区二区精品毛片,辰东完美世界有声小说,欢乐颂第一季,yy玄幻小说排行榜完本

首頁 > 編程 > VBScript > 正文

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

2020-06-26 18:40:29
字體:
來源:轉載
供稿:網友

這篇文章主要介紹了用VBS寫的VBSCRIPT代碼格式化工具VbsBeautifier,需要的朋友可以參考下

昨天在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代碼:

  1. ON ERROR RESUME NEXT:Set fso = CreateObject("Scripting.FileSystemObject"):X=0:T=true:WhiLe T 
  2.  
  3. Input=Inputbox("Filename Lowercase Batch Convertor"&vbcrlf&vbcrlf& _ 
  4.  
  5. "Please input the destination folder name. e.g. C:/Webmaster"&vbcrlf&vbcrlf& _ 
  6.  
  7. "Note: Do NOT add '/' in the end of folder name!","FLowercase Convertor","C:/"
  8.  
  9. iF Input="" then:Msgbox"Folder name is empty!",48,"Error!":T=true:else T=false:end If:wend 
  10.  
  11. Msgbox"All files names of "&Input&" will be converted to lowercase now...",64,"Note" 
  12.  
  13. fold(Input):Msgbox"Done! Total "&X&" file(s) were converted to lowercase.",64,"Done" 
  14.  
  15. sub fold(Path):SET f=fso.GetFolder(Path):Set rf = fso.GetFolder(Path).files:Set fc = f.SubFolders 
  16.  
  17. foR EACh fff in rf:lcf1=LCase(fso.GetAbsolutePathName(fff)) 
  18.  
  19. fso.MoveFile fff, lcf1:X=X + 1:next:for EacH f1 in fc:fold(f1) 
  20.  
  21. Set file=fso.GetFolder(f1).files:fOR EACh ff iN file:lcf=LCase(fso.GetAbsolutePathName(ff)) 
  22.  
  23. fso.MoveFile ff,lcf:NEXT:NEXT:END sub 

 

格式化后的VBS代碼:

  1. On Error Resume Next 
  2. Set fso = CreateObject("Scripting.FileSystemObject"
  3. X = 0 
  4. T = True 
  5. While T 
  6. Input = InputBox("Filename Lowercase Batch Convertor" & vbCrLf & vbCrLf & _ 
  7. "Please input the destination folder name. e.g. C:/Webmaster" & vbCrLf & vbCrLf & _ 
  8. "Note: Do NOT add '/' in the end of folder name!","FLowercase Convertor","C:/"
  9. If Input = "" Then 
  10. MsgBox"Folder name is empty!",48,"Error!" 
  11. T = True 
  12. Else T = False 
  13. End If 
  14. WEnd 
  15. MsgBox"All files names of " & Input & " will be converted to lowercase now...",64,"Note" 
  16. fold(Input) 
  17. MsgBox"Done! Total " & X & " file(s) were converted to lowercase.",64,"Done" 
  18. Sub fold(Path) 
  19. Set f = fso.GetFolder(Path) 
  20. Set rf = fso.GetFolder(Path).files 
  21. Set fc = f.SubFolders 
  22. For Each fff In rf 
  23. lcf1 = LCase(fso.GetAbsolutePathName(fff)) 
  24. fso.MoveFile fff, lcf1 
  25. X = X + 1 
  26. Next 
  27. For Each f1 In fc 
  28. fold(f1) 
  29. Set file = fso.GetFolder(f1).files 
  30. For Each ff In file 
  31. lcf = LCase(fso.GetAbsolutePathName(ff)) 
  32. fso.MoveFile ff,lcf 
  33. Next 
  34. Next 
  35. End Sub 


VBS代碼格式化工具的源碼:

  1. Option Explicit 
  2.  
  3. If WScript.Arguments.Count = 0 Then 
  4. MsgBox "請將要格式化的代碼文件拖動到這個文件上", vbInformation, "使用方法" 
  5. WScript.Quit 
  6. End If 
  7.  
  8. '作者: Demon 
  9. '時間: 2011/12/24 
  10. '鏈接: http://demon.tw/my-work/vbs-beautifier.html 
  11. '描述: VBScript 代碼格式化工具 
  12. '注意:  
  13. '1. 錯誤的 VBScript 代碼不能被正確地格式化 
  14. '2. 代碼中不能含有%[comment]% %[quoted]%等模板標簽, 有待改進 
  15. '3. 由2可知, 該工具不能格式化自身 
  16.  
  17. Dim Beautifier, i 
  18. Set Beautifier = New VbsBeautifier 
  19.  
  20. For Each i In WScript.Arguments 
  21. Beautifier.BeautifyFile i 
  22. Next 
  23.  
  24. MsgBox "代碼格式化完成", vbInformation, "提示" 
  25.  
  26.  
  27. Class VbsBeautifier 
  28. 'VbsBeautifier類 
  29.  
  30. Private quoted, comments, code, indents 
  31. Private ReservedWord, BuiltInFunction, BuiltInConstants, VersionInfo 
  32.  
  33. '公共方法 
  34. '格式化字符串 
  35. Public Function Beautify(ByVal input) 
  36. code = input 
  37. code = Replace(code, vbCrLf, vbLf) 
  38.  
  39. Call GetQuoted() 
  40. Call GetComments() 
  41. Call GetErrorHandling() 
  42.  
  43. Call ColonToNewLine() 
  44. Call FixSpaces() 
  45. Call ReplaceReservedWord() 
  46. Call InsertIndent() 
  47. Call FixIndent() 
  48.  
  49. Call PutErrorHandling() 
  50. Call PutComments() 
  51. Call PutQuoted() 
  52.  
  53. code = Replace(code, vbLf, vbCrLf) 
  54. code = VersionInfo & code 
  55. Beautify = code 
  56. End Function 
  57.  
  58. '公共方法 
  59. '格式化文件 
  60. Public Function BeautifyFile(ByVal path) 
  61. Dim fso 
  62. Set fso = CreateObject("scripting.filesystemobject"
  63. BeautifyFile = Beautify(fso.OpenTextFile(path).ReadAll) 
  64. '備份文件以免出錯 
  65. fso.GetFile(path).Copy path & ".bak", True 
  66. fso.OpenTextFile(path, 2, True).Write(BeautifyFile) 
  67. End Function 
  68.  
  69. Private Sub Class_Initialize() 
  70. '保留字 
  71. 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" 
  72. '內置函數 
  73. 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" 
  74. '內置常量 
  75. 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" 
  76. '版本信息 
  77. 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) 
  78. '縮進大小 
  79. Set indents = CreateObject("scripting.dictionary"
  80. indents("if") = 1 
  81. indents("sub") = 1 
  82. indents("function") = 1 
  83. indents("property") = 1 
  84. indents("for") = 1 
  85. indents("while") = 1 
  86. indents("do") = 1 
  87. indents("for") = 1 
  88. indents("select") = 1 
  89. indents("with") = 1 
  90. indents("class") = 1 
  91. indents("end") = -1 
  92. indents("next") = -1 
  93. indents("loop") = -1 
  94. indents("wend") = -1 
  95. End Sub 
  96.  
  97. Private Sub Class_Terminate() 
  98. '什么也不做 
  99. End Sub 
  100.  
  101. '將字符串替換成%[quoted]% 
  102. Private Sub GetQuoted() 
  103. Dim re 
  104. Set re = New RegExp 
  105. re.Global = True 
  106. re.Pattern = """.*?""" 
  107. Set quoted = re.Execute(code) 
  108. code = re.Replace(code, "%[quoted]%"
  109. End Sub 
  110.  
  111. '將%[quoted]%替換回字符串 
  112. Private Sub PutQuoted() 
  113. Dim i 
  114. For Each i In quoted 
  115. code = Replace(code, "%[quoted]%", i, 1, 1) 
  116. Next 
  117. End Sub 
  118.  
  119. '將注釋替換成%[comment]% 
  120. Private Sub GetComments() 
  121. Dim re 
  122. Set re = New RegExp 
  123. re.Global = True 
  124. re.Pattern = "'.*" 
  125. Set comments = re.Execute(code) 
  126. code = re.Replace(code, "%[comment]%"
  127. End Sub 
  128.  
  129. '將%[comment]%替換回注釋 
  130. Private Sub PutComments() 
  131. Dim i 
  132. For Each i In comments 
  133. code = Replace(code, "%[comment]%", i, 1, 1) 
  134. Next 
  135. End Sub 
  136.  
  137. '將冒號替換成換行 
  138. Private Sub ColonToNewLine 
  139. code = Replace(code, ":", vbLf) 
  140. End Sub 
  141.  
  142. '將錯誤處理語句替換成模板標簽 
  143. Private Sub GetErrorHandling() 
  144. Dim re 
  145. Set re = New RegExp 
  146. re.Global = True 
  147. re.IgnoreCase = True 
  148. re.Pattern = "on/s+error/s+resume/s+next" 
  149. code = re.Replace(code, "%[resumenext]%"
  150. re.Pattern = "on/s+error/s+goto/s+0" 
  151. code = re.Replace(code, "%[gotozero]%"
  152. End Sub 
  153.  
  154. '將模板標簽替換回錯誤處理語句 
  155. Private Sub PutErrorHandling() 
  156. code = Replace(code, "%[resumenext]%""On Error Resume Next"
  157. code = Replace(code, "%[gotozero]%""On Error GoTo 0"
  158. End Sub 
  159.  
  160. '格式化空格 
  161. Private Sub FixSpaces() 
  162. Dim re 
  163. Set re = New RegExp 
  164. re.Global = True 
  165. re.IgnoreCase = True 
  166. re.MultiLine = True 
  167. '去掉每行前后的空格 
  168. re.Pattern = "^[ /t]*(.*?)[ /t]*$" 
  169. code = re.Replace(code, "$1"
  170. '在操作符前后添加空格 
  171. re.Pattern = "[ /t]*(=|<|>|-|/+|&|/*|/|/^|//)[ /t]*" 
  172. code = re.Replace(code, " $1 "
  173. '去掉<>中間的空格 
  174. re.Pattern = "[ /t]*</s*>[ /t]*" 
  175. code = re.Replace(code, " <> "
  176. '去掉<=中間的空格 
  177. re.Pattern = "[ /t]*</s*=[ /t]*" 
  178. code = re.Replace(code, " <= "
  179. '去掉>=中間的空格 
  180. re.Pattern = "[ /t]*>/s*=[ /t]*" 
  181. code = re.Replace(code, " >= "
  182. '在行尾的 _ 前面加上空格 
  183. re.Pattern = "[ /t]*_[ /t]*$" 
  184. code = re.Replace(code, " _"
  185. '去掉Do While中間多余的空格 
  186. re.Pattern = "[ /t]*Do/s*While[ /t]*" 
  187. code = re.Replace(code, "Do While"
  188. '去掉Do Until中間多余的空格 
  189. re.Pattern = "[ /t]*Do/s*Until[ /t]*" 
  190. code = re.Replace(code, "Do Until"
  191. '去掉End Sub中間多余的空格 
  192. re.Pattern = "[ /t]*End/s*Sub[ /t]*" 
  193. code = re.Replace(code, "End Sub"
  194. '去掉End Function中間多余的空格 
  195. re.Pattern = "[ /t]*End/s*Function[ /t]*" 
  196. code = re.Replace(code, "End Function"
  197. '去掉End If中間多余的空格 
  198. re.Pattern = "[ /t]*End/s*If[ /t]*" 
  199. code = re.Replace(code, "End If"
  200. '去掉End With中間多余的空格 
  201. re.Pattern = "[ /t]*End/s*With[ /t]*" 
  202. code = re.Replace(code, "End With"
  203. '去掉End Select中間多余的空格 
  204. re.Pattern = "[ /t]*End/s*Select[ /t]*" 
  205. code = re.Replace(code, "End Select"
  206. '去掉Select Case中間多余的空格 
  207. re.Pattern = "[ /t]*Select/s*Case[ /t]*" 
  208. code = re.Replace(code, "Select Case "
  209. End Sub 
  210.  
  211. '將保留字 內置函數 內置常量 替換成首字母大寫 
  212. Private Sub ReplaceReservedWord() 
  213. Dim re, words, word 
  214. Set re = New RegExp 
  215. re.Global = True 
  216. re.IgnoreCase = True 
  217. re.MultiLine = True 
  218.  
  219. words = Split(ReservedWord, " "
  220. For Each word In words 
  221. re.Pattern = "(/b)" & word & "(/b)" 
  222. code = re.Replace(code, "$1" & word & "$2"
  223. Next 
  224.  
  225. words = Split(BuiltInFunction, " "
  226. For Each word In words 
  227. re.Pattern = "(/b)" & word & "(/b)" 
  228. code = re.Replace(code, "$1" & word & "$2"
  229. Next 
  230.  
  231. words = Split(BuiltInConstants, " "
  232. For Each word In words 
  233. re.Pattern = "(/b)" & word & "(/b)" 
  234. code = re.Replace(code, "$1" & word & "$2"
  235. Next 
  236. End Sub 
  237.  
  238. '插入縮進 
  239. Private Sub InsertIndent() 
  240. Dim lines, line, i, n, t, delta 
  241. lines = Split(code, vbLf) 
  242. n = UBound(lines) 
  243. For i = 0 To n 
  244. line = lines(i) 
  245. SingleLineIfThen line 
  246. t = delta 
  247. delta = delta + CountDelta(line) 
  248.  
  249. If t <= delta Then 
  250. lines(i) = String(t, vbTab) & lines(i) 
  251. Else 
  252. lines(i) = String(delta, vbTab) & lines(i) 
  253. End If 
  254. Next 
  255. code = Join(lines, vbLf) 
  256. End Sub 
  257.  
  258. '調整錯誤的縮進 
  259. Private Sub FixIndent() 
  260. Dim lines, i, n, re 
  261. Set re = New RegExp 
  262. re.IgnoreCase = True 
  263. lines = Split(code, vbLf) 
  264. n = UBound(lines) 
  265. For i = 0 To n 
  266. re.Pattern = "^/t*else" 
  267. If re.Test(lines(i)) Then 
  268. lines(i) = Replace(lines(i), vbTab, "", 1, 1) 
  269. End If 
  270. Next 
  271. code = Join(lines, vbLf) 
  272. End Sub 
  273.  
  274. '計算縮進大小 
  275. Private Function CountDelta(ByRef line) 
  276. Dim i, re, delta 
  277. Set re = New RegExp 
  278. re.Global = True 
  279. re.IgnoreCase = True 
  280. For Each i In indents.Keys 
  281. re.Pattern = "^/s*/b" & i & "/b" 
  282. If re.Test(line) Then 
  283. '方便調試 
  284. 'WScript.Echo line 
  285. line = re.Replace(line, ""
  286. delta = delta + indents(i) 
  287. End If 
  288. Next 
  289. CountDelta = delta 
  290. End Function 
  291.  
  292. '處理單行的If Then 
  293. Private Sub SingleLineIfThen(ByRef line) 
  294. Dim re 
  295. Set re = New RegExp 
  296. re.IgnoreCase = True 
  297. re.Pattern = "if.*?then.+" 
  298. line = re.Replace(line, ""
  299. '去掉Private Public前綴 
  300. re.Pattern = "(private|public).+?(sub|function|property)" 
  301. line = re.Replace(line, "$2"
  302. End Sub 
  303.  
  304. End Class 
  305. 'Demon, 于2011年平安夜 


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

發表評論 共有條評論
用戶名: 密碼:
驗證碼: 匿名發表
主站蜘蛛池模板: 甘洛县| 景谷| 巨野县| 闸北区| 成武县| 温宿县| 孟连| 家居| 建水县| 南岸区| 会东县| 广东省| 宾川县| 珠海市| 延长县| 福贡县| 长丰县| 绍兴市| 呼图壁县| 宁明县| 永年县| 新郑市| 普格县| 峨眉山市| 崇信县| 商都县| 政和县| 宣恩县| 盐亭县| 泾阳县| 旬阳县| 马山县| 泰和县| 安新县| 青铜峡市| 资溪县| 廉江市| 福建省| 莱芜市| 武隆县| 红原县|