ass2srt.vbs(ass/ssa批量转换srt的脚本)

 Option Explicit Const Encoding = "unicode" 'assume unicode 'Author: Demon 'Website: http://demon.tw 'Date: 2012/6/16 Dim shell, folder, fso, ext, i, args Set shell = CreateObject("Shell.Application") Set fso = CreateObject("scripting.filesystemobject") Set args = WScript.Arguments If args.Count = 0 Then Set folder = shell.BrowseForFolder(0, "请选择ASS字幕所在的文件夹", 1) If folder Is Nothing Then WScript.Quit For Each i In fso.GetFolder(folder.Self.Path).Files ext = LCase(fso.GetExtensionName(i.Path)) If ext = "ass" Or ext = "ssa" Then ASS2SRT i.Path, Encoding End If Next Else For i = 0 To args.Count - 1 ASS2SRT args(i), Encoding Next End If MsgBox CInt(i) & " file(s) Converted!", vbInformation Function ASS2SRT(path, charset) Const adTypeText = 2 Const adReadLine = -2 Const adSaveCreateOverWrite = 2 Dim ass, srt, re, str, arr, s, e, t, i Set ass = CreateObject("ADODB.Stream") Set srt = CreateObject("ADODB.Stream") Set re = New RegExp re.Global = True re.IgnoreCase = True re.Pattern = "\{.*?\}" ass.Type = adTypeText ass.Charset = charset ass.Open ass.LoadFromFile path srt.Type = adTypeText srt.Charset = "utf-8" srt.Open i = 0 Do Until ass.EOS str = ass.ReadText(adReadLine) If Left(str, 8) = "Dialogue" Then i = i + 1 arr = Split(str, ",", 10) s = "0" & arr(1) & "0" 'Start time e = "0" & arr(2) & "0" 'End time t = arr(9) 'Text s = Replace(s, ".", ",") e = Replace(e, ".", ",") t = re.Replace(t, "") t = Replace(t, "\n", vbCrLf) t = Replace(t, "\N", vbCrLf) srt.WriteText i & vbCrLf srt.WriteText s & " --> " & e & vbCrLf srt.WriteText t & vbCrLf & vbCrLf End If Loop path = Left(path, Len(path) - 3) & "srt" srt.SaveToFile path, adSaveCreateOverWrite End Function