Attribute VB_Name = "modSubs"
' -------------------------------------------------------------------------------
'
'   AVStoDVD - by MrC
'   File: modSubs.bas
'   Purpose: Subtitles related functions
'   Required Modules: modStr.bas, modNum.bas, modFS.bas
'
' -------------------------------------------------------------------------------


Option Explicit
Option Compare Binary
Option Base 0


Public Function Check_SRT_ANSI(InputPathname As String) As Boolean

    ' Check if the SRT text file is in ANSI format
    
    Dim NumFile As Integer
    Dim sLine As String

    NumFile = FreeFile
    Open InputPathname For Input As #NumFile
        Line Input #NumFile, sLine
    Close #NumFile
    Check_SRT_ANSI = IsNumeric(Left(sLine, 1))

End Function


' Speed up / Slow down and shift timecodes of SubRip (SRT) subs
Public Function ReSync_SRT(InputPathname As String, OutputPathname As String, Optional ConvFactor As Double = 1, Optional secShift As Double = 0) As Boolean

    Dim cInputSRT As New Collection
    Dim cOutputSRT As New Collection
    Dim NumFile As Integer
    Dim jj As Integer
    Dim kk As Integer
    Dim ii As Integer
    Dim sSub As String
    Dim sTime As String
    Dim sTime1 As String
    Dim sTime2 As String
    Dim dTime1 As Double
    Dim dTime2 As Double
    Dim dTimeNew1 As Double
    Dim dTimeNew2 As Double
    Dim sStr As String
    Dim aSub
    
    On Error GoTo Err_Handling
        
    Screen.MousePointer = vbHourglass

    Set cInputSRT = Parse_Subs_SRT(InputPathname)
    With cInputSRT
        For jj = 1 To .Count
            sSub = ""
            aSub = Split(.Item(jj), vbCrLf)
            sTime = aSub(1)
            For kk = 2 To UBound(aSub)
                sSub = sSub & aSub(kk) & vbCrLf
            Next kk
            sSub = Left(sSub, Len(sSub) - 2)
            aSub = Split(sTime, " --> ")
            sTime1 = aSub(0)
            sTime2 = aSub(1)
            aSub = Split(sTime1, ":")
            dTime1 = Val(aSub(0)) * 3600 + Val(aSub(1)) * 60 + Val(Replace(aSub(2), ",", "."))
            aSub = Split(sTime2, ":")
            dTime2 = Val(aSub(0)) * 3600 + Val(aSub(1)) * 60 + Val(Replace(aSub(2), ",", "."))
            dTimeNew1 = dTime1 * ConvFactor + secShift
            dTimeNew2 = dTime2 * ConvFactor + secShift
            If dTimeNew1 > 0 Then
                ii = ii + 1
                sStr = Replace(modStr.VisualTime(dTimeNew1, True, True) & " --> " & modStr.VisualTime(dTimeNew2, True, True), ".", ",")
                ' Fill new collection
                cOutputSRT.add ii & vbCrLf & sStr & vbCrLf & sSub, Str(ii)
            End If
        Next jj
    End With
            
    ' Output SRT
    With cOutputSRT
        NumFile = FreeFile
        Open OutputPathname For Output As #NumFile
            For jj = 1 To .Count
                Print #NumFile, .Item(jj) & vbCrLf
            Next jj
        Close #NumFile
    End With

    If Dir(OutputPathname) = "" Then
        GoTo Err_Handling
    Else
        ReSync_SRT = True
        GoTo Exit_Function
    End If
    
Err_Handling:
ReSync_SRT = False

Exit_Function:
Set cInputSRT = Nothing
Set cOutputSRT = Nothing
Screen.MousePointer = Default

End Function


Public Function Parse_Subs_SRT_Old(InputPathname As String) As Collection

    ' Input file must be in ANSI format
    
    Dim sLine As String
    Dim sSub As String
    Dim iSub As Integer
    Dim NumFile As Integer
    Dim bStartSub As Boolean
    Dim bEndSub As Boolean
    Dim ii As Long
    
    On Error Resume Next
    
    ' Initialize
    Set Parse_Subs_SRT_Old = New Collection
    sSub = ""
    bStartSub = False
    
    ' Open srt file
    NumFile = FreeFile
    Open InputPathname For Input As #NumFile
        On Error GoTo Err_Handling
        Do Until EOF(NumFile) = True
            ' Grab sub #1
            Do Until bStartSub = True
                Line Input #NumFile, sLine
                If modNum.IsNum(sLine) = True Then
                    bStartSub = True
                End If
            Loop
            iSub = Int(Val(sLine))
            ' Grab time
            Do
                Line Input #NumFile, sLine
            Loop Until InStr(1, sLine, "-->") <> 0
            sSub = iSub & vbCrLf & sLine
            ' Grap sub text
            bEndSub = False
            Do
                Line Input #NumFile, sLine
                If modNum.IsNum(sLine) = True Then
                    If Val(sLine) > Parse_Subs_SRT_Old.Count + 1 Then
                        bEndSub = True
                        bStartSub = True
                    End If
                End If
                If bEndSub = False Then
                    If sLine <> "" Then
                        sSub = sSub & vbCrLf & sLine
                    End If
                    bEndSub = EOF(NumFile)
                End If
            Loop Until bEndSub = True
            If Right(sSub, 2) = vbCrLf Then
                sSub = Left(sSub, Len(sSub) - 2)
            End If
            ' Fill collection
            If sSub <> "" Then
                ii = ii + 1
                Parse_Subs_SRT_Old.add sSub, CStr(ii)
            End If
        Loop
    Close #NumFile
    
    Exit Function
    
Err_Handling:
Select Case Err.Number
Case 9999
    Resume
End Select
Close #NumFile
Set Parse_Subs_SRT_Old = Nothing
   
End Function


Public Function Parse_Subs_SRT(InputPathname As String) As Collection

    ' Input file must be in ANSI format

    Dim sLine As String
    Dim sSub As String
    Dim NumFile As Integer
    Dim i As Long

    On Error GoTo Err_Handling

    ' Initialize
    Set Parse_Subs_SRT = New Collection
    
    ' Open srt file
    NumFile = FreeFile
    Open InputPathname For Input As #NumFile
        Do Until EOF(NumFile) = True
            sSub = ""
            ' Grab sub #1
            Do Until sSub <> ""
                Line Input #NumFile, sLine
                If IsNumeric(sLine) = True Then
                    If Val(sLine) = Int(Val(sLine)) Then sSub = sLine
                End If
            Loop
            If sSub <> "" Then
                Line Input #NumFile, sLine
                If InStr(1, sLine, "-->") <> 0 Then
                    sSub = sSub & vbCrLf & sLine
                Else
                    sSub = ""
                End If
            End If
            If sSub <> "" Then
                Do Until sLine = ""
                    Line Input #NumFile, sLine
                    If sLine <> "" Then
                        sSub = sSub & vbCrLf & sLine
                    Else
                        Exit Do
                    End If
                Loop
            End If
            If sSub <> "" Then
                i = i + 1
                Parse_Subs_SRT.add sSub, CStr(i)
            Else
                Exit Do
            End If
        Loop
    Close #NumFile
    
    Exit Function
    
Err_Handling:
Select Case Err.Number
Case 62
    Close #NumFile
Case 9999
    Resume
Case Else
    Close #NumFile
    Set Parse_Subs_SRT = Nothing
End Select


End Function


Public Function Count_SRT_Lines(InputPathname As String) As Long

    Dim SRT_Subs As New Collection
    
    Set SRT_Subs = Parse_Subs_SRT(InputPathname)
    Count_SRT_Lines = SRT_Subs.Count
    Set SRT_Subs = Nothing

End Function


Public Function Fix_SRT(InputPathname As String, OutputPathname As String) As Long

    ' Function returns # subs fixed
    ' 0 means no fixed subs (no errors)
    ' -1 means general runtme error
        
    Dim SRT_Subs As New Collection
    Dim SRT_Subs_Fixed As New Collection
    Dim NumFile As Integer
    Dim jj As Integer
    Dim kk As Integer
    Dim ii As Integer
    Dim sSub As String
    Dim sStr As String
    Dim InputSub
    Dim bFixed As Boolean
    Dim bCheck As Boolean
    Dim bFlag As Boolean
    
    On Error GoTo Err_Handling
        
    Screen.MousePointer = vbHourglass

    ' Replace Chr(10) <LF> with Chr(13)+Chr(10) <CR+LF>
    'NumFile = FreeFile
    'Open InputPathname For Input As #NumFile
    '    Do Until EOF(NumFile) = True
    '        sStr = sStr & Input(1, #NumFile)
    '    Loop
    'Close #NumFile
    'If InStr(1, sStr, vbCrLf) = 0 Then
    '    sStr = Replace(sStr, Chr(10), vbCrLf)
    '    sStr = Replace(sStr, Chr(13) & vbCrLf, vbCrLf)
    'End If
    'NumFile = FreeFile
    'Open OutputPathname For Output As #NumFile
    '    Print #NumFile, sStr
    'Close #NumFile
    
    ' Fix SRT
    Set SRT_Subs = Parse_Subs_SRT(InputPathname)
    With SRT_Subs
        For jj = 1 To .Count
            bFixed = False
            sSub = ""
            InputSub = Split(.Item(jj), vbCrLf)
            For kk = 2 To UBound(InputSub)
                sSub = sSub & InputSub(kk) & vbCrLf
            Next kk
            If sSub <> "" Then sSub = Left(sSub, Len(sSub) - 2)
            ' Remove CR+LF at the end of the line
            If Len(sSub) > 2 And Right(sSub, 2) = vbCrLf Then
                bFixed = True
                sSub = Left(sSub, Len(sSub) - 2)
            End If
            ' Remove CR+LF at the beginning of the line
            bFlag = False
            Do
                If Len(sSub) > 2 And Left(sSub, 2) = vbCrLf Then
                    bFixed = True
                    sSub = Right(sSub, Len(sSub) - 2)
                Else
                    bFlag = True
                End If
            Loop Until bFlag = True
            ' Remove <font color> formatting
            If InStr(1, LCase(sSub), "<font color=") <> 0 And InStr(1, LCase(sSub), "</font>") <> 0 Then
                sStr = Mid(sSub, InStr(1, LCase(sSub), "<font color="), InStr(1, LCase(sSub), "</font>") - InStr(1, LCase(sSub), "<font color="))
                sStr = Mid(sStr, InStr(1, sStr, ">") + 1, Len(sStr) - InStr(1, sStr, ">"))
                sSub = Mid(sSub, 1, InStr(1, sSub, "<font color=") - 1) & sStr & Mid(sSub, InStr(1, sSub, "</font>") + 7, Len(sSub) - InStr(1, sSub, "</font>") - 6)
            End If
            ' Remove </> at the beginning of the line
            If Len(sSub) > 3 And Left(sSub, 3) = "</>" Then
                bFixed = True
                sSub = Right(sSub, Len(sSub) - 3)
            End If
            ' Remove ">" at the beginning of the line
            If Left(sSub, 1) = ">" Then
                bFixed = True
                sSub = Right(sSub, Len(sSub) - 1)
            End If
            ' Replace "< " with "- " at the beginning of line
            If Left(sSub, 2) = "< " Then
                bFixed = True
                sSub = Replace(sSub, "< ", "- ")
            End If
            ' Replace "> " with "- " at the beginning of line
            If Left(sSub, 2) = "> " Then
                bFixed = True
                sSub = Replace(sSub, "> ", "- ")
            End If
            ' Replace "(" with "«"
            If InStr(1, sSub, "(") <> 0 Then
                bFixed = True
                sSub = Replace(sSub, "(", Chr(171))
            End If
            ' Replace "[" with "«"
            If InStr(1, sSub, "[") <> 0 Then
                bFixed = True
                sSub = Replace(sSub, "[", Chr(171))
            End If
            ' Replace ")" with "»"
            If InStr(1, sSub, ")") <> 0 Then
                bFixed = True
                sSub = Replace(sSub, ")", Chr(187))
            End If
            ' Replace "]" with "»"
            If InStr(1, sSub, "]") <> 0 Then
                bFixed = True
                sSub = Replace(sSub, "]", Chr(187))
            End If
            ' Replace "''" with """
            If InStr(1, sSub, "''") <> 0 Then
                bFixed = True
                sSub = Replace(sSub, "''", Chr(34))
            End If
            ' Replace "? " at the beginning of line and " ?" at the end of line with musical notes (not really an error)
            If Len(sSub) > 4 Then
                If Left(sSub, 2) = "? " And Right(sSub, 2) = " ?" Then
                    'bFixed = True
                    sSub = "<s M/> " & Mid(sSub, 3, Len(sSub) - 4) & "  <s M/>"
                End If
            End If
            ' Remove "spaces" at the end of timestamps line
            Do Until Right(InputSub(1), 1) <> " "
                bFixed = True
                InputSub(1) = Left(InputSub(1), Len(InputSub(1)) - 1)
            Loop
            ' Skip hh:mm:ss,mmm --> 00:00:00,000 timestamp
            bCheck = False
            If InStr(1, InputSub(1), "--> 00:00:00,000") <> 0 Then
                bCheck = True
            End If
            ' Skip duplicate timestamps
            If bCheck = False Then
                For kk = 1 To SRT_Subs_Fixed.Count
                    If InStr(1, SRT_Subs_Fixed.Item(kk), InputSub(1)) <> 0 Then
                        bCheck = True
                    End If
                Next kk
            End If
            If bCheck = False Then
                ii = ii + 1
                SRT_Subs_Fixed.add ii & vbCrLf & InputSub(1) & vbCrLf & sSub, Str(ii)
            Else
                bFixed = True
            End If
            Fix_SRT = Fix_SRT - CInt(bFixed)
        Next jj
    End With
    
    ' Output SRT
    modFS.DeleteIfExist OutputPathname
    With SRT_Subs_Fixed
        If .Count > 0 Then
            NumFile = FreeFile
            Open OutputPathname For Output As #NumFile
                For ii = 1 To .Count
                    Print #NumFile, .Item(ii) & vbCrLf
                Next ii
            Close #NumFile
        End If
    End With
    
    If Dir(OutputPathname) = "" Then
        GoTo Err_Handling
    Else
        GoTo Exit_Function
    End If
    
Err_Handling:
Fix_SRT = -1

Exit_Function:
Set SRT_Subs = Nothing
Set SRT_Subs_Fixed = Nothing
Screen.MousePointer = Default
    
End Function


' MicroDVD format
Public Function Parse_Subs_SUB(InputPathname As String) As Collection

    Dim sLine As String
    Dim NumFile As Integer
    Dim jj As Integer
    Dim kk As Integer
    
    On Error GoTo Err_Handling
    
    ' Initialize
    Set Parse_Subs_SUB = New Collection
 
    ' Open ass file
    NumFile = FreeFile
    Open InputPathname For Input As #NumFile
        Do Until EOF(NumFile) = True
            Line Input #NumFile, sLine
            If sLine <> "" Then
                For kk = 1 To Len(sLine)
                    If Mid(sLine, kk, 1) = "{" Then
                        sLine = Mid(sLine, kk, Len(sLine) - kk + 1)
                        Exit For
                    End If
                Next kk
                jj = jj + 1
                Parse_Subs_SUB.add sLine, CStr(jj)
            End If
        Loop
    Close #NumFile
 
    Exit Function
    
Err_Handling:
'Resume
Set Parse_Subs_SUB = Nothing
    
End Function


Public Function Convert_SUB_to_SRT(InputPathname As String, OutputPathname As String, Optional FPS As Single = 25) As Long

    Dim SUB_Subs As New Collection
    Dim SRT_Subs As New Collection
    Dim sLine As String
    Dim sStartFrame As String
    Dim sEndFrame As String
    Dim sFormat As String
    Dim sSub As String
    Dim jj As Integer
    Dim kk As Integer
    Dim ii As Integer
    Dim TimeStart As String
    Dim TimeEnd As String
    Dim NumFile As Integer
    
    On Error GoTo Err_Handling
        
    Screen.MousePointer = vbHourglass

    Set SUB_Subs = Parse_Subs_SUB(InputPathname)
    ' Convert collections
    With SUB_Subs
        If .Count > 0 Then
            For kk = 1 To .Count
                sStartFrame = ""
                sEndFrame = ""
                sFormat = ""
                sSub = ""
                sLine = .Item(kk)
                If Left(sLine, 1) = "{" Then
                    For jj = 2 To Len(sLine)
                        If Mid(sLine, jj, 1) = "}" Then Exit For
                        sStartFrame = sStartFrame & Mid(sLine, jj, 1)
                    Next jj
                    sLine = Mid(sLine, jj + 1, Len(sLine) - jj)
                    If Left(sLine, 1) = "{" Then
                        For jj = 2 To Len(sLine)
                            If Mid(sLine, jj, 1) = "}" Then Exit For
                            sEndFrame = sEndFrame & Mid(sLine, jj, 1)
                        Next jj
                        sLine = Mid(sLine, jj + 1, Len(sLine) - jj)
                        If Left(sLine, 1) = "{" Then
                            For jj = 2 To Len(sLine)
                                If Mid(sLine, jj, 1) = "}" Then Exit For
                                sFormat = sFormat & Mid(sLine, jj, 1)
                            Next jj
                            sLine = Mid(sLine, jj + 1, Len(sLine) - jj)
                        End If
                    End If
                    sSub = sLine
                    If kk = 1 Then
                        If IsNumeric(sSub) = True Then FPS = Val(sSub)
                    End If
                    If IsNumeric(sStartFrame) = True Then
                        TimeStart = Replace(modStr.VisualTime(Val(sStartFrame) / FPS, True, True), ".", ",")
                        If IsNumeric(sEndFrame) = True Then
                            TimeEnd = Replace(modStr.VisualTime(Val(sEndFrame) / FPS, True, True), ".", ",")
                            If sSub <> "" Then
                                If sFormat <> "" Then
                                    Select Case LCase(sFormat)
                                    ' Convert italic formatting
                                    Case "y:i"
                                        sSub = "<i>" & sSub & "</i>"
                                    ' Convert bold formatting
                                    Case "y:b"
                                        sSub = "<b>" & sSub & "</b>"
                                    ' Convert underline formatting
                                    Case "y:u"
                                        sSub = "<u>" & sSub & "</u>"
                                    End Select
                                End If
                                ' Convert CR+LF
                                sSub = Replace(sSub, "|", vbCrLf)
                            End If
                            ' Populate collection
                            If sSub <> "" Then
                                ii = ii + 1
                                SRT_Subs.add ii & vbCrLf & TimeStart & " --> " & TimeEnd & vbCrLf & sSub
                            End If
                        End If
                    End If
                End If
            Next kk
        End If
    End With
     ' Output SRT
    With SRT_Subs
        NumFile = FreeFile
        Open OutputPathname For Output As #NumFile
            For jj = 1 To .Count
                Print #NumFile, .Item(jj) & vbCrLf
            Next jj
        Close #NumFile
    End With
    Convert_SUB_to_SRT = ii

    GoTo Exit_Function
    
Err_Handling:
Convert_SUB_to_SRT = -1

Exit_Function:
Set SRT_Subs = Nothing
Set SUB_Subs = Nothing
Screen.MousePointer = Default

End Function


Public Function Parse_Subs_ASS(InputPathname As String) As Collection

    Dim sLine As String
    Dim aLine
    Dim NumFile As Integer
    Dim bStartSub As Boolean
    Dim jj As Integer
    Dim kk As Integer
    Dim Temp_Sub_ASS As Collection
    Dim iLayer As Integer
    Dim sSub As String
    
    On Error GoTo Err_Handling
    
    ' Initialize
    Set Parse_Subs_ASS = New Collection
    Set Temp_Sub_ASS = New Collection
    bStartSub = False
 
    ' Open ass file
    NumFile = FreeFile
    Open InputPathname For Input As #NumFile
        Do Until EOF(NumFile) = True
            ' Identify subs start
            Do Until bStartSub = True
                Line Input #NumFile, sLine
                If sLine = "[Events]" Then
                    Line Input #NumFile, sLine
                    bStartSub = True
                End If
            Loop
            Line Input #NumFile, sLine
            aLine = Split(sLine, ",")
            ' Fill temp collection
            If UBound(aLine) >= 9 Then
                If IsNumeric(Right(aLine(0), 1)) = True Then
                    If InStr(1, LCase(aLine(0)), "dialogue") <> 0 Then
                        sSub = ""
                        For kk = 9 To UBound(aLine)
                            sSub = sSub & aLine(kk)
                            If kk < UBound(aLine) Then sSub = sSub & ","
                        Next kk
                        If sSub <> "" Then
                            jj = jj + 1
                            Temp_Sub_ASS.add sLine, CStr(jj)
                        End If
                    End If
                End If
            End If
        Loop
    Close #NumFile
    ' Find lowest layer
    iLayer = 32767
    For jj = 1 To Temp_Sub_ASS.Count
        aLine = Split(Temp_Sub_ASS.Item(jj), ",")
        If Val(Right(aLine(0), 1)) < iLayer Then
            iLayer = Val(Right(aLine(0), 1))
        End If
    Next jj
    ' Fill collection with lowest layer only
    kk = 0
    For jj = 1 To Temp_Sub_ASS.Count
        aLine = Split(Temp_Sub_ASS.Item(jj), ",")
        If Val(Right(aLine(0), 1)) = iLayer Then
            kk = kk + 1
            Parse_Subs_ASS.add Temp_Sub_ASS.Item(jj), CStr(kk)
        End If
    Next jj
 
    Exit Function
    
Err_Handling:
'Resume
Set Parse_Subs_ASS = Nothing
    
End Function


Public Function Convert_ASS_to_SRT(InputPathname As String, OutputPathname As String) As Long

    Dim ASS_Subs As New Collection
    Dim SRT_Subs As New Collection
    Dim aASS
    Dim jj As Integer
    Dim kk As Integer
    Dim ii As Integer
    Dim TimeStart As String
    Dim TimeEnd As String
    Dim sSub As String
    Dim NumFile As Integer
    Dim bFlag As Boolean
    Dim lStart As Long
    Dim lEnd As Long
    
    On Error GoTo Err_Handling
        
    Screen.MousePointer = vbHourglass

    Set ASS_Subs = Parse_Subs_ASS(InputPathname)
    ' Convert collections
    With ASS_Subs
        If .Count > 0 Then
            For jj = 1 To .Count
                aASS = Split(.Item(jj), ",")
                TimeStart = aASS(1)
                TimeStart = "0" & Replace(TimeStart, ".", ",") & "0"
                TimeEnd = aASS(2)
                TimeEnd = "0" & Replace(TimeEnd, ".", ",") & "0"
                sSub = aASS(9)
                ' Handle subs with a comma inside
                If UBound(aASS) > 9 Then
                    For kk = 10 To UBound(aASS)
                        sSub = sSub & "," & aASS(kk)
                    Next kk
                End If
                ' Convert CR+LF
                sSub = Replace(sSub, "\N", vbCrLf)
                sSub = Replace(sSub, "\n", vbCrLf)
                ' Convert italic formatting
                sSub = Replace(sSub, "{\i1}", "<i>")
                sSub = Replace(sSub, "{\i0}", "</i>")
                ' Convert bold formatting
                sSub = Replace(sSub, "{\b1}", "<b>")
                sSub = Replace(sSub, "{\b0}", "</b>")
                ' Convert underline formatting
                sSub = Replace(sSub, "{\u1}", "<u>")
                sSub = Replace(sSub, "{\u0}", "</u>")
                ' Remove strikeout formatting
                sSub = Replace(sSub, "{\s1}", "")
                sSub = Replace(sSub, "{\s0}", "")
                ' Remove other formatting
                bFlag = False
                Do
                    lStart = InStr(1, sSub, "{\")
                    lEnd = InStr(1, sSub, "}")
                    If lStart > 0 And lEnd > 0 Then
                        sSub = Mid(sSub, 1, lStart - 1) & Mid(sSub, lEnd + 1, Len(sSub) - lEnd)
                    End If
                    bFlag = CBool(lStart * lEnd)
                Loop Until bFlag = False
                ' Populate collection
                If sSub <> "" Then
                    ii = ii + 1
                    SRT_Subs.add ii & vbCrLf & TimeStart & " --> " & TimeEnd & vbCrLf & sSub
                End If
            Next jj
        End If
    End With
     ' Output SRT
    With SRT_Subs
        NumFile = FreeFile
        Open OutputPathname For Output As #NumFile
            For jj = 1 To .Count
                Print #NumFile, .Item(jj) & vbCrLf
            Next jj
        Close #NumFile
    End With
    Convert_ASS_to_SRT = ii

    GoTo Exit_Function
    
Err_Handling:
Convert_ASS_to_SRT = -1

Exit_Function:
Set SRT_Subs = Nothing
Set ASS_Subs = Nothing
Screen.MousePointer = Default

End Function

Public Function Fix_IDX(InputPathname As String, OutputPathname As String) As Long

    ' Function returns # subs fixed
    ' 0 means no fixed subs (no errors)
    ' -1 means general runtme error
        
    Dim NumFile As Integer
    Dim sInputIDX As String
    Dim sBin As String * 1

    On Error GoTo Err_Handling
        
    Screen.MousePointer = vbHourglass
    
    NumFile = FreeFile
    Open InputPathname For Binary As #NumFile
        Do Until EOF(NumFile) = True
            Get #NumFile, , sBin
            If EOF(NumFile) = False Then
                If sBin = Chr(0) Then
                    Fix_IDX = Fix_IDX + 1
                    sInputIDX = sInputIDX & ""
                Else
                    sInputIDX = sInputIDX & sBin
                End If
            End If
        Loop
    Close #NumFile
    If sInputIDX <> "" Then
        NumFile = FreeFile
        Open OutputPathname For Output As #NumFile
            Print #NumFile, sInputIDX
        Close #NumFile
    End If

    GoTo Exit_Function
    
Err_Handling:
Fix_IDX = -1

Exit_Function:
Screen.MousePointer = Default

End Function
