Option Explicit

' cuepart.vbs
' Written by Neil Popham
' Version 1.0.7, 16 March 2005
'
' USAGE:
' CUEPART.VBS <cuesheet> <range> <output cuesheet> [<new file>]
'
' cuepart.vbs will create <output cuesheet>, cutting tracks <range> from
' the existing cuesheet <cuesheet>.
' cuepart.vbs will renumber the tracks, and reset the timing.
' If the <new file> parameter is passed the FILE reference will be updated.
'
' EXAMPLE USAGE:
' CUEPART.VBS "E:\My Folder\Full.cue" 2-7 "E:\My Folder\Part.cue" Part.wav
'
' See cuepart.txt for further explanation 

Dim arrArg, arrCueLines, arrLine, arrTrack, bytAsc, bytCurrentTrack
Dim bytTrackStart, bytTrackStop, objCuesheet, i, lngNewFrame, lngOffset, objArgs
Dim objFSO, objOutput, strChar, strCommand, strCueContents, strCuesheet, strNewFile
Dim strOutput, strOutputFile, strOutputPath, strTempString
Dim strTracks, strTrackStartIndex1Time, strUsage

' get command line args as collection
Set objArgs = WScript.Arguments

' check parameters are valid
If objArgs.Count < 3 Then
	WScript.Echo GetUsage()
	WScript.Quit
End If

' get individual variables
strCuesheet = objArgs(0)
strTracks = Replace(objArgs(1), " ", "")
strOutputFile = objArgs(2)
If objArgs.Count >= 4 Then strNewFile = objArgs(3) Else strNewFile = ""

Set objFSO = CreateObject("Scripting.FileSystemObject")

' check cuesheet exists
If Not objFSO.FileExists(strCuesheet) Then
	WScript.Echo "The file" & vbCrLf _
		& """" & strCuesheet & """" & vbCrLf _
		& "cannot be found"
	WScript.Quit
End If

' check track range is valid string
For i = 1 To Len(strTracks)
	bytAsc = Asc(Mid(strTracks, i, 1))
	If ((bytAsc < 48 And bytAsc <> 45) Or bytAsc > 57) Then
		WScript.Echo GetTrackRangeUsage()
		WScript.Quit
	End If
Next

' get range values from string
If InStr(strTracks, "-") > 0 Then
	bytTrackStart = GetNumeric(Split(strTracks, "-")(0))
	bytTrackStop = GetNumeric(Split(strTracks, "-")(1))
Else
	bytTrackStart = GetNumeric(strTracks)
	bytTrackStop = bytTrackStart
End If

' if bad range has been passed, or user is using format "-m" or "n-" make good
If bytTrackStart = 0 Then bytTrackStart = 1
If bytTrackStop = 0 Then bytTrackStop = 255

' load cuesheet into string
Set objCuesheet = objFSO.OpenTextFile(strCuesheet, 1, False)
strCueContents = objCuesheet.ReadAll()
objCuesheet.Close
Set objCuesheet = Nothing

' split cuesheet into lines
arrCueLines = Split(strCueContents, vbCrLf)

' set up track array
ReDim arrTrack(UBound(arrCueLines))

' loop through lines
For i = 0 To UBound(arrCueLines)

	' clean up line (remove prefixing tabs and spaces)
	arrCueLines(i) = TidyLine(arrCueLines(i))
	' split line by spaces
	arrLine = GetDelimitedParts(arrCueLines(i))
	' TRACK
	If UCase(arrLine(0)) = "TRACK" And UBound(arrLine) = 2 Then
		' get track number
		arrLine(1) = GetNumeric(arrLine(1))
		' if valid track number, record character position of this line
		If arrLine(1) > 0 Then 
			arrTrack(arrLine(1)) = InStr(1, strCueContents, arrCueLines(i), vbTextCompare)
			bytCurrentTrack = CByte(arrLine(1))
		End If
		
	' INDEX
	ElseIf UCase(arrLine(0)) = "INDEX" And UBound(arrLine) = 2 Then
		' if this is index 1 of the first track we want, get the index time
		If GetNumeric(arrLine(1)) = 1 And bytCurrentTrack = bytTrackStart Then
			strTrackStartIndex1Time = arrLine(2)
		End If
	End If
Next
' get final position
arrTrack(bytCurrentTrack + 1) = Len(strCueContents) + 1

' if range min/max is larger than the cuesheet restrict to last track
If bytTrackStart > bytCurrentTrack Then bytTrackStart = bytCurrentTrack
If bytTrackStop > bytCurrentTrack Then bytTrackStop = bytCurrentTrack

' check that we can get requested range
If GetNumeric(arrTrack(1)) = 0 _
Or GetNumeric(arrTrack(bytTrackStart)) = 0 _
Or GetNumeric(arrTrack(bytTrackStop + 1)) = 0 Then
	WScript.Echo "Invalid range passed (" & bytTrackStart & "-" & bytTrackStop & ")"
	WScript.Quit
End If

' grab just the bits we want (pre-track 01, and track n -> track m)
If arrTrack(1) > 1 Then strOutput = Left(strCueContents, arrTrack(1) - 1)
strOutput = strOutput & Mid(strCueContents, arrTrack(bytTrackStart), _
	arrTrack(bytTrackStop + 1) - arrTrack(bytTrackStart))

' split into lines
arrCueLines = Split(strOutput, vbCrLf)

' calculate offset from index 01 of first new track
lngOffset = GetFramesFromTime(strTrackStartIndex1Time)

' loop through lines
For i = 0 To UBound(arrCueLines)

	' clean up line (remove prefixing tabs and spaces)
	arrCueLines(i) = Replace(Trim(arrCueLines(i)), vbTab, "")
	' split line by spaces
	arrLine = GetDelimitedParts(arrCueLines(i))

	' INDEX
	If UCase(arrLine(0)) = "INDEX" And UBound(arrLine) = 2 Then
		' re-time index
		lngNewFrame = GetFramesFromTime(arrLine(2)) - lngOffset
		If lngNewFrame >= 0 Then
			strTempString = arrLine(0) & " " & arrLine(1) & " " _
				& GetTimeFromFrames(lngNewFrame)
		Else
			strTempString = "PREGAP " & GetTimeFromFrames(Abs(lngNewFrame))
		End If
		strOutput = Replace(strOutput, arrCueLines(i), strTempString)
		
	' TRACK
	ElseIf UCase(arrLine(0)) = "TRACK" And UBound(arrLine) = 2 Then
		' re-number track
		strTempString = arrLine(0) & " " & Pad(GetNumeric(arrLine(1)) - bytTrackStart + 1) _
			& " " & arrLine(2)
		strOutput = Replace(strOutput, arrCueLines(i), strTempString)
		
	' FILE
	ElseIf UCase(arrLine(0)) = "FILE" And UBound(arrLine) = 2 And strNewFile <> "" Then
		' rename file
		strTempString = arrLine(0) & " """ & strNewFile & """ " _
			& GetFileType(strNewFile)
		strOutput = Replace(strOutput, arrCueLines(i), strTempString)
	End If
Next

' trim new text
strOutput = Trim(strOutput)
strOutput = "REM Created using cuepart.vbs" _
	& " (http://www.neilpopham.pwp.blueyonder.co.uk/)" _
	& vbCrLf & vbCrLf & strOutput

' check output path and create folders if necessary
strOutputPath = GetPath(strOutputFile)
If strOutputPath = "" Then
	' no path provided, set output path to input path
	If GetPath(strCuesheet) <> "" Then strOutputFile = GetPath(strCuesheet) & "\" & strOutputFile
Else
	If Not objFSO.FolderExists(strOutputPath) Then
		CreateFolders(strOutputPath)
	End If
End If

' write to file
Set objOutput = objFSO.CreateTextFile(strOutputFile, True)
objOutput.Write strOutput
objOutput.Close
Set objOutput = Nothing

' tidy up
Set objFSO = Nothing

' Function GetFramesFromTime()
' Returns a number of frames from a time format of MM:SS:FF
' See also GetTimeFromFrames()
Function GetFramesFromTime(ByVal strTime)
	Dim arrPart
	arrPart = Split(strTime, ":")
	If UBound(arrPart) <> 2 Then GetFramesFromTime = 0 : Exit Function
	GetFramesFromTime = GetNumeric(arrPart(2)) + _
		+ (GetNumeric(arrPart(1)) * 75) _
		+ (GetNumeric(arrPart(0)) * 4500)
End Function

' Function GetTimeFromFrames()
' Returns a string of format MM:SS:FF from a number of frames
' See also GetFramesFromTime()
Function GetTimeFromFrames(ByVal lngFrames)
	Dim intMinutes, bytSeconds, bytFrames
	bytFrames = lngFrames Mod 75
	intMinutes = lngFrames \ 4500
	bytSeconds = (lngFrames \ 75) - (intMinutes * 60)
	GetTimeFromFrames = Pad(intMinutes) & ":" & Pad(bytSeconds) & ":" & Pad(bytFrames)
End Function

' Function Pad()
' Pads numbers to two digits
Function Pad(ByVal bytNo)
	If bytNo < 10 Then Pad = "0" & CStr(bytNo) Else Pad = CStr(bytNo)
End Function

' Function IsNumber()
' Returns whether a value is numeric or not
Function IsNumber(ByVal lngID)
	IsNumber = (IsNumeric(lngID) And lngID <> "" And Not IsNull(lngID))
End Function

' Function GetNumeric()
' Return a long integer derived from the input or 0 if input is non-numeric
Function GetNumeric(ByVal varID)
	If Not IsNumber(varID) Then varID = 0
	GetNumeric = CLng(varID)
End Function

' Function TidyLine()
' Strips a line of text of unnecessary spaces, tabs, etc.
Function TidyLine(ByVal strLine)
	strLine = Replace(strLine, vbTab, " ")
	strLine = Trim(strLine)
	While Instr(strLine, "  ") > 0
		strLine = Replace(strLine, "  ", " ")
	Wend
	TidyLine = strLine
End Function

' Function GetDelimitedParts()
' Returns an array of parts separated by spaces, ignoring spaces that have been encased in quotes
Function GetDelimitedParts(ByVal strText)
	Dim blnInQuotes, i, strChar, strTempString, arrParts
	' clean string
	strText = Trim(strText)
	strTempString = ""
	' loop through all characters to find spaces outside of quotes
	blnInQuotes = False
	For i = 1 To Len(strText)
		strChar = Mid(strText, i, 1)
		' quote found - we are either beginning or ending quoted text
		If strChar = """" Then
			blnInQuotes = Not blnInQuotes
		End If
		' if character is a space and we are currently in quotes
		If strChar = " " And blnInQuotes Then
			' replace space with placeholder
			strTempString = strTempString & Chr(182)
		Else
			' add character
			strTempString = strTempString & strChar
		End If
	Next
	' split new string using spaces
	arrParts = Split(strTempString, " ")
	' ensure that an array is passed back
	If UBound(arrParts) = -1 Then ReDim arrParts(0)
	' clean up parts and replace placeholder with space again
	For i = 0 To UBound(arrParts)
		arrParts(i) = Replace(Trim(arrParts(i)), Chr(182), " ")
		arrParts(i) = Replace(arrParts(i), """", "")
	Next
	' return array
	GetDelimitedParts = arrParts
End Function

' Function GetPath()
' Returns only the directory path from a file path
Function GetPath(ByVal strPath)
	Dim intPos
	intPos = InStrRev(strPath, "\")
	If intPos > 0 Then
		GetPath = Left(strPath, intPos - 1)
	Else
		GetPath = ""
	End If
End Function

' Function GetFileName()
' Returns the filename from a path
Function GetFileName(ByVal strPath)
	Dim intPos
	intPos = InStrRev(strPath, "\")
	If intPos > 0 Then
		GetFileName = Mid(strPath, intPos + 1)
	Else
		GetFileName = strPath
	End If
End Function

' Function GetExtension()
' Returns the file extension from a path
Function GetExtension(ByVal strPath)
	Dim intPos
	intPos = InStrRev(strPath, ".")
	If intPos > 0 Then
		GetExtension = LCase(Mid(strPath, intPos + 1))
	Else
		GetExtension = ""
	End If
End Function

' Function GetFileType()
' Returns the FILE FILETYPE for a path or file
Function GetFileType(ByVal strPath)
	Dim strExt
	strExt = GetExtension(strPath)
	Select Case strExt
	Case "mp3"
		GetFileType = "MP3"
	Case "aiff"
		GetFileType = "AIFF"
	Case Else
		GetFileType = "WAVE"
	End Select
End Function

' Function CreateFolders()
' Iteratively creates a path of folders
Function CreateFolders(ByVal strPath)
	If Not objFSO.FolderExists(GetPath(strPath)) Then
		CreateFolders(GetPath(strPath))
	End If
	objFSO.CreateFolder(strPath)
End Function

' Function GetUsage()
Function GetUsage()
	' set usage string
	GetUsage = "Usage:" & vbCrLf _
		& vbCrLf _
		& "cuepart.vbs <cuesheet> <track range> <output cusheet> [<new file>]" & vbCrLf _
		& vbCrLf _
		& "<cuesheet>, <output cusheet> and <new file> must be surrounded by" & vbCrLf _
		& "double quotes if they contain spaces." & vbCrLf _
		& vbCrLf _
		& GetTrackRangeUsage() & vbCrLf _
		& vbCrLf _
		& "See cuepart.txt for further explanation."
End Function

' Function GetTrackRangeUsage()
Function GetTrackRangeUsage()
	GetTrackRangeUsage = "<track range> must be of the format: [n]-m, n-[m], or n" _
		& vbCrLf _
		& "e.g.: 1-3 , 4- , -4 , or 1 "
End Function