VB编写程序实现视频外挂SRT字幕

      在DVDRip、MKV等720P高清视频中，srt、ssa、ass、idx、sub等外挂字幕非常流行，采用的显示技术毫不例外都是VSFilter（早期版本是VobSub）和AviSynth外挂字幕插件。显示的点阵汉字非常漂亮！现在流行的多媒体播放器，如KMPlayer、暴风影音等都采用了上述DirectVobSub技术。虽然DirectVobSub技术具有开放性强，支持众多语言编写的播放器，但经常有挂不上字幕的问题。于是，想到用VB来编写外挂字幕程序。那VB能否实现外挂字幕呢？答案是肯定的！对于idx、sub等图形字幕来说，VB无能为力；但对于文本字幕srt、ssa、ass，VB还是可以解决的。虽不能和DirectVobSub技术相比，但基本功能还是可以实现的。请看下面VB编写的srt字幕解析代码：

 

'********************************************************************************
'* 模块名称：Srttitle.bas
'* 调用srt字幕文件成功后：SRTFileAnalysis返回字幕个数（每一个srt字幕可能有多行显示文本）
'* 调用失败后SRTFileAnalysis返回一个长整型数0
'* 特别声明：转载请用IP地址，严禁原文转载！
'* 作者：Chenjl1031(东方之珠) 
'********************************************************************************

Option Explicit

 

Public SRTtitle() As String 'srt字幕数组

 

'srt字幕提取
Public Function SRTFileAnalysis(ByVal SrtFileName As String) 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, sSrt() As String
       Dim GotTime As Boolean
       Dim sHour As Long, sMunite As Long, sSecond As Long, s1 As Long, s2 As Long, s3 As Long
      
       On Error Resume Next
      
       If Dir(SrtFileName) = "" Then SRTFileAnalysis = 0: Exit Function
       '扫描srt字幕个数并定义字幕数组
       FileNumber = FreeFile: LineCount = 1
       Open SrtFileName For Input Lock Read As #FileNumber
       Do While Not EOF(FileNumber)
          Line Input #FileNumber, Stitle '提取srt字幕标签
          If IsNumeric(Stitle) Then LineCount = LineCount + 1
       Loop
       Close #FileNumber
       SRTFileAnalysis = LineCount - 1
       ReDim SRTtitle(1 To LineCount - 1)
      
       '提取字幕内容和显示时间
       FileNumber = FreeFile: LineCount = 1: GotTime = False
       Open SrtFileName For Input Lock Read As #FileNumber

       Do While Not EOF(FileNumber)
          Line Input #FileNumber, Stitle '提取srt字幕标签
          Stitle = Trim(Stitle)
         
          If GotTime = True Then '已经取到时间标签
             If IsNumeric(Stitle) = False Then
                If Len(Stitle) <> 0 Then St = St & (Stitle & "-CRLF-") 'CRLF回车换行
             Else '进入下一个字幕
                GotTime = False '已经提取完第LineCount个字幕
                If Len(St) = 0 Then St = Space(10) ': Debug.Print Stitle
                SRTtitle(LineCount) = TimeLabel(1) & " [StartTime] " & TimeLabel(2) & " [EndTime] " & St '加上时间标签头
                SRTtitle(LineCount) = Trim(Left(SRTtitle(LineCount), Len(SRTtitle(LineCount)) - 6))
                St = "": LineCount = LineCount + 1 '记录字幕序号
             End If
          End If

          '判断并提取时间标签
          TimeLenth = InStr(1, Stitle, "-->")
          If TimeLenth > 0 Then
             TimeLabel(1) = Trim(Left(Stitle, TimeLenth - 1)) '字幕显示开始时间
             s1 = InStr(1, TimeLabel(1), ":")
             s2 = InStr(s1 + 1, TimeLabel(1), ":")
             sHour = CLng(Left(TimeLabel(1), s1 - 1)) * 3600000
             sMunite = CLng(Mid(TimeLabel(1), s1 + 1, s2 - s1 - 1)) * 60000
             sSecond = CLng(Mid(TimeLabel(1), s2 + 1, Len(TimeLabel(1)) - s2))
             TimeLabel(1) = CStr(sHour + sMunite + sSecond)
            
             TimeLabel(2) = Trim(Right(Stitle, Le