Option Explicit

'Just a wrapper for passing strings instead of byte arrays.
Public Function StringDiffs(ByVal first As String, ByVal other As String) As String
    Dim firstChars() As Byte
    Dim otherChars() As Byte
    firstChars = StrConv(first, vbFromUnicode)
    otherChars = StrConv(other, vbFromUnicode)
    StringDiffs = FindDifferences(firstChars, otherChars)
End Function

'Returns a comma delimited string containing the positions of differences in the passed byte arrays. Recursive.
'Arrays are not modified, index parameters specify where the pointers are in the arrays on each subsequent call.
Private Function FindDifferences(ByRef first() As Byte, ByRef other() As Byte, Optional ByVal firstStartIndex As Long = -1, _
                                 Optional ByVal firstEndIndex As Long, Optional ByVal otherStartIndex As Long, _
                                 Optional ByVal otherEndIndex As Long) As String

    If firstStartIndex = -1 Then
        'Find matching substrings and set index markers.
        SkipSubstringMatches first, other, firstStartIndex, firstEndIndex, otherStartIndex, otherEndIndex
        If firstEndIndex = -1 And otherEndIndex > 0 Then
            'All matches in first.
            Exit Function
        ElseIf otherEndIndex = -1 And firstEndIndex > 0 Then
            'All matches in other.
            FindDifferences = FormatIndexSpanForOutput(firstStartIndex, firstEndIndex)
            Exit Function
        ElseIf firstEndIndex = -1 And otherEndIndex = -1 Then
            'Identical input.
            Exit Function
        End If
    End If

    Dim matchLength As Long
    Dim firstMatch As Long
    Dim otherMatch As Long

    FindNextMatch first, other, firstStartIndex, firstEndIndex, otherStartIndex, otherEndIndex, firstMatch, otherMatch, matchLength

    Dim differences As String
    Dim returnValue As String
    'Test to see if there are unmatched chars.
    If matchLength <> 0 Then
        differences = FindDifferences(first, other, firstStartIndex, firstMatch - 1, otherStartIndex, otherMatch - 1)
        If Len(differences) <> 0 Then returnValue = returnValue & "," & differences
        differences = FindDifferences(first, other, firstMatch + matchLength, firstEndIndex, otherMatch + matchLength, otherEndIndex)
        If Len(differences) <> 0 Then returnValue = returnValue & "," & differences
    Else
        returnValue = returnValue & "," & FormatIndexSpanForOutput(firstStartIndex, firstEndIndex)
    End If

    If Right$(returnValue, 1) = "," Then
        returnValue = Left$(returnValue, Len(returnValue) - 1)
    End If

    If Left$(returnValue, 1) = "," Then
        returnValue = Right$(returnValue, Len(returnValue) - 1)
    End If

    FindDifferences = returnValue
End Function

'Sets ByRef index parameters to the position of the first mismatched byte from both the start and end. Arrays are not modified.
Private Sub SkipSubstringMatches(ByRef first() As Byte, ByRef other() As Byte, ByRef firstStartIndex As Long, _
                                 ByRef firstEndIndex As Long, ByRef otherStartIndex As Long, ByRef otherEndIndex As Long)

    Dim topFirst As Long
    Dim topOther As Long
    Dim baseFirst As Long

    topFirst = UBound(first)
    topOther = UBound(other)
    baseFirst = LBound(first)

    Dim lower As Long
    If topFirst >= topOther Then
        lower = topOther
    Else
        lower = topFirst
    End If

    Dim index As Long
    Do Until index > lower
        If first(index) <> other(index) Then
            Exit Do
        End If
        index = index + 1
    Loop

    firstStartIndex = index
    otherStartIndex = index

    '-1 indicates all matches.
    If index > topFirst Then
        firstEndIndex = -1
        otherEndIndex = topOther
    ElseIf index > topOther Then
        otherEndIndex = -1
        firstEndIndex = topFirst
    End If

    If firstEndIndex = -1 Or otherEndIndex = -1 Then
        Exit Sub
    Else
        Do Until first(topFirst) <> other(topOther)
            topFirst = topFirst - 1
            topOther = topOther - 1
            If topFirst < baseFirst Or topOther < baseFirst Then
                Exit Do
            End If
        Loop
        firstEndIndex = topFirst
        otherEndIndex = topOther
    End If
End Sub

'Advance indexes until the next matches are found.
Private Sub FindNextMatch(ByRef first() As Byte, ByRef other() As Byte, ByRef firstStartIndex As Long, _
                          ByRef firstEndIndex As Long, ByRef otherStartIndex As Long, ByRef otherEndIndex As Long, _
                          ByRef matchPositionFirst As Long, ByRef matchPositionOther As Long, ByRef matchLength As Long)

    Dim tempIndex As Long
    Dim result As Long
    Dim firstIndex As Long
    Dim otherIndex As Long

    For otherIndex = otherStartIndex To otherEndIndex
        firstIndex = firstStartIndex
        Do Until firstIndex >= firstEndIndex
            'Seek forward in first until there is a match.
            Do Until other(otherIndex) = first(firstIndex)
                firstIndex = firstIndex + 1
                If firstIndex = firstEndIndex Then
                    Exit Do
                End If
            Loop
            'Concurrently seek forward in both until a mismatch is found.
            tempIndex = otherIndex
            Do Until other(tempIndex) <> first(firstIndex)
                tempIndex = tempIndex + 1
                firstIndex = firstIndex + 1
                If firstIndex > firstEndIndex Then
                    Exit Do
                End If
                If tempIndex > otherEndIndex Then
                    Exit Do
                End If
            Loop
            'Calculate match indexes and length.
            result = tempIndex - otherIndex
            If result > matchLength Then
                matchLength = result
                matchPositionOther = otherIndex
                matchPositionFirst = firstIndex - matchLength
            End If
            If matchLength > firstEndIndex - firstIndex Then
                Exit Do
            End If
        Loop
        If matchLength + otherIndex > otherEndIndex Then
            'No possible matches left.
            Exit For
        End If
    Next
End Sub

'Returns a comma delimited string of indexes between starting and ending, rebases to 1 base.
Private Function FormatIndexSpanForOutput(ByVal starting As Long, ByVal ending As Long) As String
    Dim returnValue As String
    If starting = ending Then
        returnValue = CStr(ending + 1)
    Else
        Dim index As Long
        For index = starting To ending - 1
            returnValue = returnValue & CStr(index + 1) & ","
        Next index
        If starting < ending Then
            returnValue = returnValue & CStr(ending + 1)
        End If
    End If

    FormatIndexSpanForOutput = returnValue
End Function