VB解析SRT、SSA、ASS字幕文件，以实现视频外挂字幕

  上篇文章《VB编写程序实现视频外挂SRT字幕》(http://blog.csdn.net/chenjl1031/archive/2010/03/01/5337289.aspx)，只写了解决SRT字幕文件。这次把三种格式（SRT，SSA，ASS）都柔和在一起，没有分别编写，在上篇文章基础上直接改的。SSA和ASS特效代码有很多相同的地方，其中ASS特效代码80%与SSA相同，只提取VB能够处理的基本信息，其余的特效代码VB不好办，全部扔掉。在试验中发现有的字幕文件编码是Uncode格式，有的是UTF-8编码格式，有的是Ansi编码格式，在这方面作了识别，以便VB能够正确处理。下面是解析这三种字幕文件的全部程序：

 

 

Option Explicit Private Declare Function MultiByteToWideChar Lib "kernel32.dll" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long Private Const UTF8FT As Long = 65001 '代码页 'SRT,SSA,ASS字幕提取，SubtitlesFilesName为字幕文件名 Public Function SubtitlesFileAnalysis(ByVal SubtitlesFilesName As String) As Long Dim GetFileExtendName As String '取得文件的扩展名 Dim FileByte() As Byte '存放字幕文件字节 Dim strBuffer As String, UTF8Size As Long, BufferSize As Long, UTF8Result As Long Dim LineCount As Long, FileNumber As Long, TimeLenth As Long, TimeNumber As Long Dim Stitle As String, TimeLabel(1 To 2) As String, St As String, StC As String Dim Fbyte() As Byte, Temp() As String, sTime() As String, TT() As String, sTT() As String '临时数组 Dim tStyle() As String, sStyle() As String '缺省的字幕信息和自定义字幕信息 Dim V4StyleFormat As String, EventsFormat As String '缺省的字幕格式和对话事件格式 Dim sName As String, sFontname As String, sFontsize As String, sPrimaryColour As String, sBold As String, sItalic As String, sUnderline As String '从V4+Styles中取出的字体信息 Dim DefaultFontIfo As String '缺省的字体信息 Dim StartPosition As Long ', EndPo As Long, StylePo As Long, TextPo As Long '记录开始时间，结束时间，样式，字幕文本起始位置 Dim sHour As Long, sMunite As Long, sSecond As Long, s1 As Long, s2 As Long, s3 As Long, s4 As Long Dim GotTime As Boolean On Error Resume Next '缺省的字体信息:fn字体类型，fs字体大小，fc字体颜色，fp字体位置，fi斜体，fu下划线，fb粗体 DefaultFontIfo = "[fn=黑体][fs=24][fc=&HFFFFFF][fp=2][fi=0][fu=0][fb=0] " sUnderline = "0" If Dir(SubtitlesFilesName) = "" Or FileLen(SubtitlesFilesName) = 0 Then SubtitlesFileAnalysis = 0: Exit Function '字幕不存在即退出 GetFileExtendName = Mid$(SubtitlesFilesName, 1 + InStrRev(SubtitlesFilesName, "."), Len(SubtitlesFilesName) - InStrRev(SubtitlesFilesName, ".")) Debug.Print GetFileExtendName '确定字幕文件编码格式，并将字幕文本导入到临时数组TT中 FileNumber = FreeFile Open SubtitlesFilesName For Binary As #FileNumber ReDim FileByte(LOF(FileNumber) - 1), Fbyte(LOF(FileNumber) - 1) Get #FileNumber, , FileByte Close #FileNumber If (Hex$(FileByte(0)) = "FF" And Hex$(FileByte(1)) = "FE") Or (Hex$(FileByte(0)) = "FE" And Hex$(FileByte(1)) = "FF") Then If Hex$(FileByte(0)) = "FF" Then '字幕文件为Unicode（Little Endian）编码 Stitle = StrConv(FileByte, vbNarrow) End If If Hex$(FileByte(0)) = "FE" Then '字幕文件为Unicode Big Endian编码 For s1 = 0 To UBound(FileByte) If s1 Mod 2 = 0 Then Fbyte(s1) = FileByte(s1 + 1) Else Fbyte(s1) = FileByte(s1 - 1) End If Next Stitle = StrConv(Fbyte, vbNarrow) End If Mid$(Stitle, 1, 1) = " ": Stitle = Trim(Stitle) Else If (Hex$(FileByte(0)) = "EF" And Hex$(FileByte(1)) = "BB" And Hex$(FileByte(2)) = "BF") Then '字幕文件为UTF-8编码 UTF8Size = UBound(FileByte) + 1 BufferSize = MultiByteToWideChar(UTF8FT, 0&, FileByte(0), UTF8Size, 0&, 0&) strBuffer = String$(BufferSize, vbNullChar) UTF8Result = MultiByteToWideChar(UTF8FT, 0&, FileByte(0), UTF8Size, StrPtr(strBuffer), BufferSize) If UTF8Result > 0 Then Stitle = Left$(strBuffer, UTF8Result) Mid$(Stitle, 1, 1) = " ": Stitle = Trim(Stitle) Else Exit Function End If Else '字幕文件为Ansi编码，或其它非Unicode、UTF-8编码格式 Stitle = StrConv(FileByte, vbUnicode) End If End If Erase FileByte, Fbyte '释放动态数组所使用的内存 Temp = Split(Stitle, vbCrLf) '导出的全部字幕文本 '扫描对话字幕个数并定义字幕数组 LineCount = 1: s2 = 0 'srt字幕 If LCase(GetFileExtendName) = "srt" Then For s1 = 0 To UBound(Temp) If InStr(1, Temp(s1), "-->") > 0 Then LineCount = LineCount + 1 Next SubtitlesFileAnalysis = LineCount - 1 '确定srt字幕个数 ReDim Subtitles(1 To LineCount - 1) '定义srt字幕数组 End If 'ssa,ass字幕 If LCase(GetFileExtendName) = "ssa" Or LCase(GetFileExtendName) = "ass" Then For s1 = 0 To UBound(Temp) If InStr(1, Temp(s1), "Dialogue:") > 0 Then LineCount = LineCount + 1 If InStr(1, Temp(s1), "Style:") > 0 Then s2 = s2 + 1 If InStr(1, Temp(s1), "Format:") > 0 Then If InStr(1, Temp(s1), "Encoding") > 0 Then V4StyleFormat = Trim(Replace(Temp(s1), "Format:", Space(7))) End If If InStr(1, Temp(s1),