'Changes timing in SMI file

Option Explicit

Main

Sub Main
Const ForReading = 1
Dim fs, ts, strFile, strLine, strSmil
Dim lngStart, lngEnd, strStart, strEnd, strTimeCodeMillisecs, lngTimeCodeMillisecs, lngCorrectedTimeCodeMillisecs
Dim dblTime1, dblTime2, dblCorrection1, dblCorrection2, dblSlope, dblOffset
'Get the correction data
MsgBox "This will be a two-point correction. I'll need two times in the video, with caption corrections for both times."
dblTime1 = InputBox ("Video time in decimal minutes of first sound clip:","First Time", "1")
dblCorrection1 = InputBox ("Sound minus Caption time in seconds for the first clip (positive numbers if text appears before voice):","First Correction", "5")
dblTime2 = InputBox ("Video time in decimal minutes of second sound clip:","Second Time", "59")
dblCorrection2 = InputBox ("Sound minus Caption time in seconds for the second clip (positive numbers if text appears before voice):","Second Correction", "5")
'Standardize everything in milliseconds
dblTime1 = dblTime1 * 60000
dblTime2 = dblTime2 * 60000
dblCorrection1 = dblCorrection1 * 1000
dblCorrection2 = dblCorrection2 * 1000
'Calculate the correction slope
dblSlope = (dblCorrection2 - dblCorrection1) / (dblTime2 - dblTime1)
'Calculate the correction offset
dblOffset = dblCorrection1 - (dblTime1 * dblSlope)

	Set fs = CreateObject("Scripting.FileSystemObject")
	If WScript.Arguments.Count <> 1 Then Exit Sub
	strFile = WScript.Arguments(0)
	If Not fs.FileExists(strFile) Then Exit Sub
	Set ts = fs.OpenTextFile(strFile, ForReading, True)
	strSmil = ""
	Do Until ts.AtEndOfStream
		'Read a line in and add a CRLF to the output
		strLine = ts.ReadLine
		If strSmil <> "" Then strSmil = strSmil & vbCrLf
		'See if the line has SYNC caption timing data
		lngStart = InStr(1, strLine, "<SYNC", vbTextCompare)
		If lngStart <> 0 Then
			'Walk through the SYNC tag to the START, then to the = to find the number
			lngStart = InStr(lngStart, strLine, "START", vbTextCompare)
			lngStart = InStr(lngStart, strLine, "=", vbTextCompare)
			lngStart = lngStart + 1
			'Find the end of the SYNC tag. Really hope there's nothing between the number and the end of the tag!
			lngEnd = InStr(lngStart, strLine, ">", vbTextCompare)
			strStart = Left(strLine, lngStart - 1)
			strEnd = Mid(strLine, lngEnd)
			'The SYNC time code is now (hopefully) available
			strTimeCodeMillisecs = Mid(strLine, lngStart, lngEnd - lngStart)
			'Clean up the time code
			strTimeCodeMillisecs = Replace(strTimeCodeMillisecs, """", "")
			strTimeCodeMillisecs = Trim(strTimeCodeMillisecs)
			'With any luck we actually retrieved a number
			If IsNumeric(strTimeCodeMillisecs) Then
				lngTimeCodeMillisecs = CLng(strTimeCodeMillisecs)
				If lngTimeCodeMillisecs <> 0 Then
					'Add the fixed offset
					lngCorrectedTimeCodeMillisecs = lngTimeCodeMillisecs + dblOffset
					'Add the correction per second
					lngCorrectedTimeCodeMillisecs = Clng(lngCorrectedTimeCodeMillisecs + (lngTimeCodeMillisecs * dblSlope))
					'Make the new line with the corrected value
					strSmil = strSmil & strStart & Cstr(lngCorrectedTimeCodeMillisecs) & strEnd
				Else
					strSmil = strSmil & strLine
				End If
			Else
				strSmil = strSmil & strLine
			End If
		Else
			strSmil = strSmil & strLine
		End If
	Loop
	ts.Close
	String2File strSmil, strFile
End Sub



Function String2File(strData, strFileName)
'Writes a string to a file. Returns True if success.
Dim fs 'As Scripting.FileSystemObject
Dim ts 'As Scripting.TextStream
Dim lngChar, strBlock, intChar, dtTimeStamp
Const ForWriting = 2
	Set fs = CreateObject("Scripting.FileSystemObject")
	On Error Resume Next
	If fs.FileExists(strFileName) Then
		dtTimeStamp = fs.GetFile(strFileName).DateLastModified
	Else
		dtTimeStamp = CDate(0)
	End If
	Err.Clear
	Set ts = fs.OpenTextFile(strFileName, ForWriting, True)
	ts.Write strData
	If Err.Number <> 0 Then
		'Must have hit one of the "problem characters" between 128 and 159
		For lngChar = 1 To Len(strData) Step 100
			Err.Clear
			ts.Write Mid(strData, lngChar, 100)
			If Err.Number <> 0 Then
				'This block of 100 must have the problem. Write them one-at-a-time
				strBlock = Mid(strData, lngChar, 100)
				For intChar = 1 To Len(strBlock)
					ts.Write Chr(255 And AscW(Mid(strBlock, intChar)))
				Next
			End If
		Next
	End If
	ts.Close
	If fs.FileExists(strFileName) Then
		If dtTimeStamp = fs.GetFile(strFileName).DateLastModified Then
			String2File = False
		Else
			String2File = True
		End If
	Else
		String2File = False
	End If
End Function