在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,":") 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,Len(Stitle) - TimeLenth - 3)) '字幕显示结束时间 s1 = InStr(1,TimeLabel(2),":") sHour = CLng(Left(TimeLabel(2),s1 - 1)) * 3600000 sMunite = CLng(Mid(TimeLabel(2),s2 - s1 - 1)) * 60000 sSecond = CLng(Mid(TimeLabel(2),Len(TimeLabel(2)) - s2)) TimeLabel(2) = CStr(sHour + sMunite + sSecond) GotTime = True End If DoEvents Loop '提取最后一个字幕 SRTtitle(LineCount) = TimeLabel(1) & " [StartTime] " & TimeLabel(2) & " [EndTime] " & SRTtitle(LineCount) & St '加上时间标签头 SRTtitle(LineCount) = Trim(Left(SRTtitle(LineCount),Len(SRTtitle(LineCount)) - 6)) Close #FileNumber '检查SRT字幕特效代码 For LineCount = 1 To UBound(SRTtitle) '检查换行符:<br>,/N;空格符:/n,/h s1 = InStr(1,SRTtitle(LineCount),"/N") If s1 > 0 Then SRTtitle(LineCount) = Left$(SRTtitle(LineCount),s1 - 1) & " -CRLF- " & Right$(SRTtitle(LineCount),Len(SRTtitle(LineCount)) - s1 - 2) s2 = InStr(1,"<br>") If s2 > 0 Then SRTtitle(LineCount) = Left$(SRTtitle(LineCount),s2 - 1) & " -CRLF- " & Right$(SRTtitle(LineCount),Len(SRTtitle(LineCount)) - s2 - 3) s1 = InStr(1,"/n") If s1 > 0 Then SRTtitle(LineCount) = Left$(SRTtitle(LineCount),s1 - 1) & Right$(SRTtitle(LineCount),Len(SRTtitle(LineCount)) - s1 - 1) s2 = InStr(1,"/h") If s2 > 0 Then SRTtitle(LineCount) = Left$(SRTtitle(LineCount),s2 - 1) & Right$(SRTtitle(LineCount),Len(SRTtitle(LineCount)) - s2 - 1) '初始化:fn字体类型,fs字体大小,fc字体颜色,fp字体位置,fi斜体,fu下划线,fb粗体。这些特效代码符合ASS字幕特效规范。其余特效代码一律扔掉。 If InStr(1,"-CRLF-") > 0 Then sSrt = Split(SRTtitle(LineCount),"-CRLF-") s2 = InStr(1,sSrt(0),"[EndTime]") St = Left$(sSrt(0),s2 + 8) & " [fn=黑体][fs=24][fc=&HFFFFFF][fp=2][fi=0][fu=0][fb=0] " & Right$(sSrt(0),Len(sSrt(0)) - s2 - 8) For s1 = 1 To UBound(sSrt) St = St & (" -CRLF- " & "[fn=黑体][fs=24][fc=&HFFFFFF][fp=2][fi=0][fu=0][fb=0] " & sSrt(s1)) '& " -CRLF- ") Next Else s2 = InStr(1,"[EndTime]") If Len(SRTtitle(LineCount)) - s2 - 8 >= 0 Then St = Left$(SRTtitle(LineCount),s2 + 8) & " [fn=黑体][fs=24][fc=&HFFFFFF][fp=2][fi=0][fu=0][fb=0] " & Right$(SRTtitle(LineCount),Len(SRTtitle(LineCount)) - s2 - 8) End If End If SRTtitle(LineCount) = St: Erase sSrt '检查所用字体、字号、颜色、位置等信息 If InStr(1,"-CRLF-") > 0 Then sSrt = Split(SRTtitle(LineCount),"-CRLF-") For s1 = 0 To UBound(sSrt) St = "/fn": StC = "[fn=" sSrt(s1) = Insert_String(sSrt(s1),St,StC,5): GoSub LinkSrt St = "/fs": StC = "[fs=" sSrt(s1) = Insert_String(sSrt(s1),5): GoSub LinkSrt St = "/c": StC = "[fc=" sSrt(s1) = Insert_String(sSrt(s1),11): GoSub LinkSrt St = "/a": StC = "[fp=" sSrt(s1) = Insert_String(sSrt(s1),4): GoSub LinkSrt St = "/i": StC = "[fi=" sSrt(s1) = Insert_String(sSrt(s1),4): GoSub LinkSrt St = "/u": StC = "[fu=" sSrt(s1) = Insert_String(sSrt(s1),4): GoSub LinkSrt St = "/b": StC = "[fb=" sSrt(s1) = Insert_String(sSrt(s1),4): GoSub LinkSrt Exit For LinkSrt: St = sSrt(0) For s3 = 1 To UBound(sSrt) '合并字幕 St = St & (" -CRLF- " & sSrt(s3)) Next SRTtitle(LineCount) = St Return Next Else St = "/fn": StC = "[fn=" SRTtitle(LineCount) = Insert_String(SRTtitle(LineCount),5) St = "/fs": StC = "[fs=" SRTtitle(LineCount) = Insert_String(SRTtitle(LineCount),5) St = "/c": StC = "[fc=" SRTtitle(LineCount) = Insert_String(SRTtitle(LineCount),11) St = "/a": StC = "[fp=" SRTtitle(LineCount) = Insert_String(SRTtitle(LineCount),4) St = "/i": StC = "[fi=" SRTtitle(LineCount) = Insert_String(SRTtitle(LineCount),4) St = "/u": StC = "[fu=" SRTtitle(LineCount) = Insert_String(SRTtitle(LineCount),4) St = "/b": StC = "[fb=" SRTtitle(LineCount) = Insert_String(SRTtitle(LineCount),4) End If Erase sSrt SRTtitle(LineCount) = GetXMLCodeValue(SRTtitle(LineCount),ByVal "<i>") SRTtitle(LineCount) = GetXMLCodeValue(SRTtitle(LineCount),ByVal "<u>") SRTtitle(LineCount) = GetXMLCodeValue(SRTtitle(LineCount),ByVal "<b>") SRTtitle(LineCount) = GetXMLCodeValue(SRTtitle(LineCount),ByVal "color=") SRTtitle(LineCount) = DeleEffectCode(SRTtitle(LineCount),ByVal "<",ByVal ">") SRTtitle(LineCount) = DeleEffectCode(SRTtitle(LineCount),ByVal "{",ByVal "}")
Next
End Function
'取出字符串中SSA、ASS特效字符串、插入Srt特效字符串 Private Function Insert_String(ByVal SourceSrtTitle As String,ByVal SrtEffectCode As String,ByVal SrtCode As String,ByVal LEffect As Long) As String Dim s1 As Long,s3 As Long,St As String If Len(Trim(SourceSrtTitle)) = 0 Then Insert_String = Space(10): Exit Function s1 = 0 On Error Resume Next Cjl: s1 = InStr(s1 + 1,SourceSrtTitle,SrtEffectCode) If SrtEffectCode = "/b" And s1 > 0 Then If Mid$(SourceSrtTitle,s1,3) = "/be" Then GoTo Cjl End If s3 = Len(SrtEffectCode) If s1 > 0 Then s2 = InStr(s1 + 1,"/") If s2 > 0 Then St = Mid$(SourceSrtTitle,s1 + s3,s2 - s1 - s3) If InStr(1,"{") > 0 Then St = Left$(St,InStr(1,"{") - 1) & Right$(St,Len(St) - InStr(1,"{")) If InStr(1,"}") > 0 Then St = Left$(St,"}") - 1) & Right$(St,"}")) Else s2 = InStr(s1 + 1,"}") If s2 > 0 Then St = Mid$(SourceSrtTitle,s2 - s1 - s3) End If End If s2 = InStr(1,SrtCode) If InStr(1,SrtEffectCode,"/fn") > 0 Or InStr(1,"/fs") > 0 Then Insert_String = Left$(SourceSrtTitle,s2 + s3) & St & Right$(SourceSrtTitle,Len(SourceSrtTitle) - s2 - LEffect) Else Insert_String = Left$(SourceSrtTitle,s2 + s3 + 1) & St & Right$(SourceSrtTitle,Len(SourceSrtTitle) - s2 - LEffect) End If Else Insert_String = SourceSrtTitle End If End Function
'取得srt字幕中类似XML代码的值 Private Function GetXMLCodeValue(ByVal SourceSrtTitle As String,ByVal SrtXMLcode As String) As String Dim LineCount As Long,sSrt() As String Dim P1 As Long,P2 As Long,P3 As Long,CO As String,St As String Dim Pc1 As Long,Pc2 As Long Dim i As Long,j As Long,K As Long On Error Resume Next If InStr(1,"-CRLF-") > 0 Then If InStr(1,SrtXMLcode) > 0 Then sSrt = Split(SourceSrtTitle,"-CRLF-") 'ReDim sSrt_1(UBound(sSrt)) For LineCount = 0 To UBound(sSrt) P1 = InStr(1,sSrt(LineCount),SrtXMLcode) St = Mid$(LCase(SrtXMLcode),2,1): P2 = InStr(1,"</" & St & ">") If LCase(SrtXMLcode) = "color=" Then P2 = InStr(1,"</font>") If InStr(1,"color=") > 0 Then Pc1 = InStr(1,"color="): Pc2 = InStr(Pc1 + 6,">") CO = Mid$(sSrt(LineCount),Pc1 + 6,Pc2 - Pc1 - 6) If InStr(1,CO,Chr$(34)) > 0 Then CO = "&H" & Mid$(CO,Len(CO) - 2) If InStr(1,"#") > 0 Then CO = "&H" & Right$(CO,Len(CO) - InStr(1,"#")) End If End If K = LineCount If P1 > 0 Then St = Mid$(LCase(SrtXMLcode),1): P3 = InStr(1,sSrt(K),"f" & St & "="): Mid$(sSrt(K),P3 + 3,1) = "1" If LCase(SrtXMLcode) = "color=" Then Pc1 = InStr(1,"fc="): Pc2 = InStr(1,"][fp") sSrt(K) = Left$(sSrt(K),Pc1 + 2) & CO & Right$(sSrt(K),Len(sSrt(K)) - Pc2 + 1) End If If P2 > 0 Then GoTo Cjl Else For i = LineCount + 1 To UBound(sSrt) St = Mid$(LCase(SrtXMLcode),1): j = InStr(1,sSrt(i),"</" & St & ">") If LCase(SrtXMLcode) = "color=" Then j = InStr(1,"</font>") K = i St = Mid$(LCase(SrtXMLcode),Len(sSrt(K)) - Pc2 + 1) End If If j > 0 Then Exit For Next End If End If Cjl: '执行下一次循环 Next St = sSrt(0) For i = 1 To UBound(sSrt) '合并字幕 St = St & (" -CRLF- " & sSrt(i)) Next Erase sSrt GetXMLCodeValue = St Else GetXMLCodeValue = SourceSrtTitle End If
Else If InStr(1,SrtXMLcode) > 0 Then St = Mid$(LCase(SrtXMLcode),1): P1 = InStr(1,"f" & St & "="): Mid$(SourceSrtTitle,P1 + 3,1) = "1" If LCase(SrtXMLcode) = "color=" Then P1 = InStr(1,"color="): P2 = InStr(P1 + 6,">") CO = Mid$(SourceSrtTitle,P1 + 6,P2 - P1 - 6) If InStr(1,"#")) P1 = InStr(1,"fc="): P2 = InStr(1,"][fp") SourceSrtTitle = Left$(SourceSrtTitle,P1 + 2) & CO & Right$(SourceSrtTitle,Len(SourceSrtTitle) - P2 + 1) End If GetXMLCodeValue = SourceSrtTitle Else GetXMLCodeValue = SourceSrtTitle End If End If End Function
'去掉所有特效代码Private Function DeleEffectCode(ByVal SourceSrtTitle As String,ByVal StartCh As String,ByVal EndCh As String) As String Dim P1 As Long,PS As Long On Error Resume Next PS = 1 Do While InStr(PS,StartCh) > 0 P1 = InStr(PS,StartCh) P2 = InStr(P1 + 1,EndCh) Mid$(SourceSrtTitle,P1,P2 - P1 + 1) = Space(P2 - P1 + 1) PS = P2 + 1 DoEvents Loop DeleEffectCode = Trim(SourceSrtTitle) End Function (编辑:李大同)
【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容!
|