回 帖 发 新 帖 刷新版面

主题:一江秋水大哥请进

萨菲空间阿斯利康放大镜看了

回复列表 (共16个回复)

沙发

把你的代码压缩后作为附件发上来,我看看

板凳


现在smi与srt之间的转换还没思路实现,大哥也帮忙看看啊

3 楼

新的代码要自己编写,我只能帮你修改。附件修改如下:

Dim Data As String
Dim filename As String
Dim filetype As String
Dim i, k As Long

Private Sub Command2_Click()
Command1.Enabled = True
Command3.Enabled = True
Command4.Enabled = True
CommonDialog1.ShowOpen
filename = LCase(CommonDialog1.filename)
Label1.Caption = filename
filetype = Right(filename, 3)
Label2.Caption = filetype
If filetype = "lrc" Then Command3.Enabled = False
If filetype = "srt" Then Command1.Enabled = False
If filetype = "smi" Then Command4.Enabled = False
GetFileText (filename)
End Sub

Private Sub GetFileText(filename As String)
If Len(filename) < 8 Then Exit Sub
Dim NextLine As String
Data = ""
Open filename For Input As #1
Do Until EOF(1)
  Line Input #1, NextLine
  Data = Data & NextLine & vbCrLf
Loop
Close
End Sub

Private Sub Command1_Click()
Dim test As String, time1 As String, time2 As String, st As String
Dim j As Integer, n As Integer
n = 1: i = 0
If filetype = "lrc" Then
  Do
    i = InStr(i + 1, Data, "["): If i = 0 Then Exit Sub
  Loop Until IsNumeric(Mid(Data, i + 1, 2))
  Do
    time1 = changLRCtoSRT(Mid(Data, i + 1, 8))
    k = InStr(i, Data, vbCrLf)
    j = InStr(k, Data, "[")
    If j > 0 Then
      test = Mid(Data, i + 10, k - i - 10)
      time2 = changLRCtoSRT(Mid(Data, j + 1, 8))
    Else
      test = Mid(Data, i + 10, k - i - 10)
      time2 = Mid(Data, i + 1, 8)
      time2 = Val(time2) * 60000 + Val(Mid$(time2, 4)) * 1000 + 10000 '将时间字串转换为毫秒
      time2 = changLRCtoSRT(changSMItoLRC(time2))
    End If
    st = st & n & vbCrLf & time1 & "9" & " --> " & time2 & "0" & vbCrLf & test & vbCrLf & vbCrLf
    n = n + 1: i = j
  Loop Until i = 0
ElseIf filetype = "smi" Then

End If
'If Len(Dir(Left(filename, Len(filename) - 3) & "srt")) > 0 Then Kill Left(filename, Len(filename) - 3) & "srt"
Open Left(filename, Len(filename) - 3) & "srt" For Output As #1
Print #1, st
Close #1
MsgBox ("已完成转换,目标文件保存在被转换文件目录下!")
End Sub

Private Function changLRCtoSRT(s As String) As String
changLRCtoSRT = "00:" & Replace(s, ".", ",")
End Function

Private Function changSMItoLRC(a As String) As String
Dim c As String, s As Long
s = Val(a)
c = Format(s \ 60000, "00") & ":" & Format((s Mod 60000) \ 1000, "00") & "." & Format((s Mod 60000 Mod 1000) \ 10, "00") '将播放时间位置转换为时间字串
changSMItoLRC = c
End Function

Private Function changSRTtoLRC(s As String) As String
Dim c As String, a As Long
c = Left(s, 2)
If c = "00" Then
  c = Mid(s, 4, 3) & Mid(s, 7, 2) & "." & Mid(s, 10, 2)
Else
  a = Val(c) * 60 + Val(Mid(s, 4, 2)): If a > 99 Then a = 99
  c = a & ":" & Mid(s, 7, 2) & "." & Mid(s, 10, 2)
End If
changSRTtoLRC = c
End Function

Private Sub Command3_Click()
Dim test As String
i = 1: k = 1
test = "[ti:]" & vbCrLf & "[ar:]" & vbCrLf & "[al:]" & vbCrLf & "[by:]" & vbCrLf
If filetype = "smi" Then
  Data = LCase(Data)
  Do
    i = InStr(i, Data, "start="): If i = 0 Then Exit Do
    test = test & "[" & changSMItoLRC(Mid(Data, i + 6, 10)) & "]"
    i = InStr(i + 1, Data, "egcc>")
    test = test & Mid(Data, i + 5, InStr(i, Data, vbCrLf) - i - 5) & vbCrLf
  Loop
ElseIf filetype = "srt" Then
  Do
    i = InStr(k, Data, "-->"): If i = 0 Then Exit Do
    test = test & "[" & changSRTtoLRC(Mid(Data, i - 13, 12)) & "]"
    i = InStr(i, Data, vbCrLf) + 2
    k = InStr(i, Data, vbCrLf)
    test = test & Mid(Data, i, k - i) & vbCrLf
  Loop
End If
'If Len(Dir(Left(filename, Len(filename) - 3) & "lrc")) > 0 Then Kill Left(filename, Len(filename) - 3) & "lrc"
Open Left(filename, Len(filename) - 3) & "lrc" For Output As #1
Print #1, test
Close #1
MsgBox ("已完成转换,目标文件保存在被转换文件目录下!")
End Sub

4 楼

Private Sub Command3_Click()
Dim test As String
i = 1: k = 1
test = "[ti:]" & vbCrLf & "[ar:]" & vbCrLf & "[al:]" & vbCrLf & "[by:]" & vbCrLf
If filetype = "smi" Then
  Data = LCase(Data)
  Do
    i = InStr(i, Data, "start="): If i = 0 Then Exit Do
    test = test & "[" & changSMItoLRC(Mid(Data, i + 6, 10)) & "]"
    i = InStr(i + 1, Data, "egcc>")
    test = test & Mid(Data, i + 5, InStr(i, Data, vbCrLf) - i - 5) & vbCrLf
  Loop
ElseIf filetype = "srt" Then
  Do
    i = InStr(k, Data, "-->"): If i = 0 Then Exit Do
    test = test & "[" & changSRTtoLRC(Mid(Data, i - 13, 12)) & "]"
    i = InStr(i, Data, vbCrLf) + 2
    k = InStr(i, Data, vbCrLf)
    test = test & Mid(Data, i, k - i) & vbCrLf
  Loop
End If
'If Len(Dir(Left(filename, Len(filename) - 3) & "lrc")) > 0 Then Kill Left(filename, Len(filename) - 3) & "lrc"
Open Left(filename, Len(filename) - 3) & "lrc" For Output As #1
Print #1, test
Close #1
MsgBox ("已完成转换,目标文件保存在被转换文件目录下!")
End Sub

5 楼

这段代码有问题,你看看

6 楼

如果按照您smi字幕文件制作的思路的话,smi转为lrc的代码应该如何写才能像你那样有打开和保存函数啊

7 楼

又进行了一下优化,应该达到了你的所有要求,注意我把按纽顺序改了。

Option Explicit

Dim Data As String
Dim FileType As String
Dim st As String
Dim i As Long, k As Long

Private Sub Command1_Click()
Dim OpenName As String, NextLine As String
CommonDialog1.ShowOpen
OpenName = LCase(CommonDialog1.FileName)
If Len(OpenName) < 8 Then Exit Sub

FileType = Right(OpenName, 3)
If InStr("srt lrc smi", FileType) = 0 Then MsgBox "文件类型错误": Exit Sub
Label1 = OpenName

Command2.Enabled = True
Command3.Enabled = True
Command4.Enabled = True

Select Case FileType
  Case "srt": Command2.Enabled = False
  Case "lrc": Command3.Enabled = False
  Case "smi": Command4.Enabled = False
End Select

Data = ""
Open OpenName For Input As #1
Do Until EOF(1)
  Line Input #1, NextLine
  Data = Data & NextLine & vbCrLf
Loop
Close
End Sub

Private Function changLRCtoSRT(s As String) As String
changLRCtoSRT = "00:" & Replace(s, ".", ",")
End Function

Private Function changSMItoLRC(s As String) As String
Dim a As Long
a = Val(s)
changSMItoLRC = Format(a \ 60000, "00") & ":" & Format((a Mod 60000) \ 1000, "00") & "." & Format((a Mod 60000 Mod 1000) \ 10, "00")
End Function

Private Function changSRTtoLRC(s As String) As String
Dim c As String, a As Long
c = Left(s, 2)
If c = "00" Then
  c = Mid(s, 4, 3) & Mid(s, 7, 2) & "." & Mid(s, 10, 2)
Else
  a = Val(c) * 60 + Val(Mid(s, 4, 2)): If a > 99 Then a = 99 'lrc的最大分钟值为99
  c = a & ":" & Mid(s, 7, 2) & "." & Mid(s, 10, 2)
End If
changSRTtoLRC = c
End Function

Private Function lrcTOsrt(dat As String) As String
Dim test As String, time1 As String, time2 As String, z As String
Dim j As Integer, n As Integer
n = 1: i = 0
Do
  i = InStr(i + 1, dat, "["): If i = 0 Then Exit Function
Loop Until IsNumeric(Mid(dat, i + 1, 2))    '如果是时间字串就跳出
Do
  time1 = changLRCtoSRT(Mid(dat, i + 1, 8)) '将lrc的8位时间参数转为srt的第一时间参数
  k = InStr(i, dat, vbCrLf)                 '歌词结束位置
  j = InStr(k, dat, "[")                    '歌词起始位置
  test = Mid(dat, i + 10, k - i - 10)       '取出歌词
  If j > 0 Then
    time2 = changLRCtoSRT(Mid(dat, j + 1, 8)) '将lrc的8位时间参数转为srt的第二时间参数
  Else
    time2 = Mid(dat, i + 1, 8)
    time2 = Val(time2) * 60000 + Val(Mid$(time2, 4)) * 1000 + 10000 '最后的时间加上10秒
    time2 = changLRCtoSRT(changSMItoLRC(time2)) '将lrc的8位时间参数转为srt最后一行的第二时间参数
  End If
  z = z & n & vbCrLf & time1 & "9" & " --> " & time2 & "0" & vbCrLf & test & vbCrLf & vbCrLf
  n = n + 1: i = j
Loop Until i = 0
lrcTOsrt = z
End Function

紧接后面

8 楼


Private Function smiTOlrc(dat As String) As String
Dim z As String
i = 1
z = "[ti:]" & vbCrLf & "[ar:]" & vbCrLf & "[al:]" & vbCrLf & "[by:]" & vbCrLf
dat = LCase(dat)
Do
  i = InStr(i, dat, "start="): If i = 0 Then Exit Do
  z = z & "[" & changSMItoLRC(Mid(dat, i + 6, 10)) & "]"
  i = InStr(i + 1, dat, "egcc>")
  z = z & Mid(dat, i + 5, InStr(i, dat, vbCrLf) - i - 5) & vbCrLf
Loop
smiTOlrc = z
End Function

Private Function strTOlrc(dat As String) As String
Dim z As String
k = 1
z = "[ti:]" & vbCrLf & "[ar:]" & vbCrLf & "[al:]" & vbCrLf & "[by:]" & vbCrLf
Do
  i = InStr(k, dat, "-->"): If i = 0 Then Exit Do
  z = z & "[" & changSRTtoLRC(Mid(dat, i - 13, 12)) & "]"
  i = InStr(i, dat, vbCrLf) + 2
  k = InStr(i, dat, vbCrLf)
  z = z & Mid(dat, i, k - i) & vbCrLf
Loop
strTOlrc = z
End Function

Private Function lrcTOsmi(dat As String) As String
Dim t As Long, s As String, z As String, test As String
i = 1
k = InStr(1, dat, vbCrLf)
Do While k > 0                                  '如果有回车符就继续循环
  test = Mid$(dat, i, k - i)                    '从歌词句中取出含有方括号的字串
  s = Mid$(test, 2, InStr(test, "]") - 2)       '取出去掉了方括号的字串
  If IsNumeric(Left$(s, 2)) Then                '如果是时间字串
    t = Val(s) * 60000 + Val(Mid$(s, 4)) * 1000 '将时间字串转换为毫秒
    z = z & "<sync start=" & t & "><p class=EGCC>" & Mid$(test, InStr(test, "]") + 1) & vbCrLf
  End If
  i = k + 2: k = InStr(i, dat, vbCrLf)
Loop
lrcTOsmi = z
End Function
  
Private Sub Command2_Click()
Select Case FileType
  Case "lrc": st = lrcTOsrt(Data)
  Case "smi": st = lrcTOsrt(smiTOlrc(Data))
End Select
savefile "srt"
End Sub

Private Sub Command3_Click()
Select Case FileType
  Case "smi": st = smiTOlrc(Data)
  Case "srt": st = strTOlrc(Data)
End Select
savefile "lrc"
End Sub

Private Sub Command4_Click()
Select Case FileType
  Case "lrc": st = lrcTOsmi(Data)
  Case "srt": st = lrcTOsmi(strTOlrc(Data))
End Select
st = "<SAMI><head>" & vbCrLf & "<style type=" & Chr(34) & "text/css" & Chr(34) & "><!--" & vbCrLf & "p     {font-size:24pt;font-family:楷体_GB2312;}" & vbCrLf & ".FRCC {lang: ZH-CN;}" & "--></style></head>" & vbCrLf & "<body>" & vbCrLf & st & "</body></SAMI>"
savefile "smi"
End Sub

Private Sub savefile(f As String)
Open Left(Label1, Len(Label1) - 3) & f For Output As #1
Print #1, st
Close #1
MsgBox ("已完成转换,目标文件保存在被转换文件目录下!")
End Sub

9 楼

Private Function lrcTOsmi(dat As String) As String
Dim t As Long, s As String, z As String, test As String
i = 1
k = InStr(1, dat, vbCrLf)
Do While k > 0                                  '如果有回车符就继续循环
  test = Mid$(dat, i, k - i)                    '从歌词句中取出含有方括号的字串
  s = Mid$(test, 2, InStr(test, "]") - 2)       '取出去掉了方括号的字串
  If IsNumeric(Left$(s, 2)) Then                '如果是时间字串
    t = Val(s) * 60000 + Val(Mid$(s, 4)) * 1000 '将时间字串转换为毫秒
    z = z & "<sync start=" & t & "><p class=EGCC>" & Mid$(test, InStr(test, "]") + 1) & vbCrLf
  End If
  i = k + 2: k = InStr(i, dat, vbCrLf)
Loop
lrcTOsmi = z
End Function

10 楼

lrc转smi这段代码有问题,这个地方出错了: s = Mid$(test, 2, InStr(test, "]") - 2)       '取出去掉了方括号的字串
希望得到解答

我来回复

您尚未登录,请登录后再回复。点此登录或注册