Scaling SRT subtitle timestamps

Sometimes the downloaded SRT subtitle is faster or slower than the actual movie.

The timestamps are either upscaled/downscaled by a constant K and not by an offset. The following code attempts to adjust the subtitle timestamps to fit the movie.

Const K As Double = 0.95905 'scale constant
Const timeFormat As String = "HH:mm:ss,fff" 'format of timestamps

'get the total number of miliseconds in a datetime. Ignore the date component
Public Function GetTotalMSeconds(ByVal dt As DateTime) As Double
Return dt.Hour * 3600000 + dt.Minute * 60000 + dt.Second * 1000 + dt.Millisecond
End Function

'convert the specified amount of miliseconds to datetime. Ignore the date component
Public Function GetDateTimeFromMSeconds(ByVal msecs As Double) As DateTime
Dim hour As Integer = CInt(Math.Floor(msecs / 3600000))
Dim minute As Integer = CInt(Math.Floor((msecs - hour * 3600000) / 60000))
Dim seconds As Integer = CInt(Math.Floor((msecs - hour * 3600000 - minute * 60000) / 1000))
Dim milisec As Integer = CInt(Math.Floor(msecs - hour * 3600000 - minute * 60000 - seconds * 1000))
Return New DateTime(Now.Year, Now.Month, Now.Day, hour, minute, seconds, milisec)
End Function

Sub Main()

'SRT file will look like
'1:
'00:00:03,203 --> 00:00:05,194
'[Music playing]
'[Music playing line 2]

'2:
'00:00:14,381 --> 00:00:17,350
'[Tapping, spring rattling]

'3:
'00:00:17,384 --> 00:00:19,716
'[Scrapes]
'For simplicity, assume all 2nd lines after a blank line contains the timestamp. Only modify these lines

Dim sr As StreamReader = File.OpenText("c:\temp\test.srt")
Dim sw As StreamWriter = File.CreateText("c:\temp\Finding Nemo (2003).srt")
Dim waitCount As Integer = 0
While Not sr.EndOfStream
Dim st As String = sr.ReadLine()
waitCount += 1

'find the timestamp line
If waitCount = 2 Then
Debug.WriteLine("Old value: " + st)

'scale the timestamp
'e.g
'old value: 01:39:56,324 --> 01:39:57,951
'new value: 01:35:50,774 --> 01:35:52,334
If st.Length > 0 Then
Dim splitArr As String() = st.Split(New String() {"-->"}, StringSplitOptions.None)
Dim timeStart As DateTime = DateTime.ParseExact(splitArr(0).Trim, timeFormat, System.Globalization.CultureInfo.CurrentCulture)
Dim timeEnd As DateTime = DateTime.ParseExact(splitArr(1).Trim, timeFormat, System.Globalization.CultureInfo.CurrentCulture)

Dim timeStartNew As DateTime = New DateTime(CLng(timeStart.Ticks * K))
Dim timeStartEnd As DateTime = New DateTime(CLng(timeStart.Ticks * K))

Dim stNew As String = GetDateTimeFromMSeconds(GetTotalMSeconds(timeStart) * K).ToString(timeFormat) + "-->" + GetDateTimeFromMSeconds(GetTotalMSeconds(timeEnd) * K).ToString(timeFormat)
Debug.WriteLine("New value: " + stNew)

'change the string
st = stNew
End If
End If

'encounter an empty line, new timestamp will be encountered
If st.Length = 0 Then
waitCount = 0
End If

sw.WriteLine(st)
End While

'close the file
sr.Close()
sw.Close()
End Sub

Most of the code is straightforward. Notice the following:

Dim timeEnd As DateTime = DateTime.ParseExact(splitArr(1).Trim, timeFormat, System.Globalization.CultureInfo.CurrentCulture)

This converts the timestamp string into a DateTime value. Had we not used DateTime.ParseExact, but Convert.ToDateTime, the miliseconds part of the original timestamp would have been lost! DateTime.ParseExact allows us to specify a custom format string as well as keeping the miliseconds part.

To scale a timestamp, multiply the Time part by a constant K. This is done by converting the DateTime value into seconds, multiplying the seconds by K, and finally converting it back to DateTime. Multiplying the Ticks property would not work, as this would take into account the Date part of the DateTime value.