Guest User

Untitled

a guest
Mar 1st, 2017
157
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Option Explicit
  2.  
  3. 'Just a wrapper for passing strings instead of byte arrays.
  4. Public Function StringDiffs(ByVal first As String, ByVal other As String) As String
  5. Dim firstChars() As Byte
  6. Dim otherChars() As Byte
  7. firstChars = StrConv(first, vbFromUnicode)
  8. otherChars = StrConv(other, vbFromUnicode)
  9. StringDiffs = FindDifferences(firstChars, otherChars)
  10. End Function
  11.  
  12. 'Returns a comma delimited string containing the positions of differences in the passed byte arrays. Recursive.
  13. 'Arrays are not modified, index parameters specify where the pointers are in the arrays on each subsequent call.
  14. Private Function FindDifferences(ByRef first() As Byte, ByRef other() As Byte, Optional ByVal firstStartIndex As Long = -1, _
  15. Optional ByVal firstEndIndex As Long, Optional ByVal otherStartIndex As Long, _
  16. Optional ByVal otherEndIndex As Long) As String
  17.  
  18. If firstStartIndex = -1 Then
  19. 'Find matching substrings and set index markers.
  20. SkipSubstringMatches first, other, firstStartIndex, firstEndIndex, otherStartIndex, otherEndIndex
  21. If firstEndIndex = -1 And otherEndIndex > 0 Then
  22. 'All matches in first.
  23. Exit Function
  24. ElseIf otherEndIndex = -1 And firstEndIndex > 0 Then
  25. 'All matches in other.
  26. FindDifferences = FormatIndexSpanForOutput(firstStartIndex, firstEndIndex)
  27. Exit Function
  28. ElseIf firstEndIndex = -1 And otherEndIndex = -1 Then
  29. 'Identical input.
  30. Exit Function
  31. End If
  32. End If
  33.  
  34. Dim matchLength As Long
  35. Dim firstMatch As Long
  36. Dim otherMatch As Long
  37.  
  38. FindNextMatch first, other, firstStartIndex, firstEndIndex, otherStartIndex, otherEndIndex, firstMatch, otherMatch, matchLength
  39.  
  40. Dim differences As String
  41. Dim returnValue As String
  42. 'Test to see if there are unmatched chars.
  43. If matchLength <> 0 Then
  44. differences = FindDifferences(first, other, firstStartIndex, firstMatch - 1, otherStartIndex, otherMatch - 1)
  45. If Len(differences) <> 0 Then returnValue = returnValue & "," & differences
  46. differences = FindDifferences(first, other, firstMatch + matchLength, firstEndIndex, otherMatch + matchLength, otherEndIndex)
  47. If Len(differences) <> 0 Then returnValue = returnValue & "," & differences
  48. Else
  49. returnValue = returnValue & "," & FormatIndexSpanForOutput(firstStartIndex, firstEndIndex)
  50. End If
  51.  
  52. If Right$(returnValue, 1) = "," Then
  53. returnValue = Left$(returnValue, Len(returnValue) - 1)
  54. End If
  55.  
  56. If Left$(returnValue, 1) = "," Then
  57. returnValue = Right$(returnValue, Len(returnValue) - 1)
  58. End If
  59.  
  60. FindDifferences = returnValue
  61. End Function
  62.  
  63. 'Sets ByRef index parameters to the position of the first mismatched byte from both the start and end. Arrays are not modified.
  64. Private Sub SkipSubstringMatches(ByRef first() As Byte, ByRef other() As Byte, ByRef firstStartIndex As Long, _
  65. ByRef firstEndIndex As Long, ByRef otherStartIndex As Long, ByRef otherEndIndex As Long)
  66.  
  67. Dim topFirst As Long
  68. Dim topOther As Long
  69. Dim baseFirst As Long
  70.  
  71. topFirst = UBound(first)
  72. topOther = UBound(other)
  73. baseFirst = LBound(first)
  74.  
  75. Dim lower As Long
  76. If topFirst >= topOther Then
  77. lower = topOther
  78. Else
  79. lower = topFirst
  80. End If
  81.  
  82. Dim index As Long
  83. Do Until index > lower
  84. If first(index) <> other(index) Then
  85. Exit Do
  86. End If
  87. index = index + 1
  88. Loop
  89.  
  90. firstStartIndex = index
  91. otherStartIndex = index
  92.  
  93. '-1 indicates all matches.
  94. If index > topFirst Then
  95. firstEndIndex = -1
  96. otherEndIndex = topOther
  97. ElseIf index > topOther Then
  98. otherEndIndex = -1
  99. firstEndIndex = topFirst
  100. End If
  101.  
  102. If firstEndIndex = -1 Or otherEndIndex = -1 Then
  103. Exit Sub
  104. Else
  105. Do Until first(topFirst) <> other(topOther)
  106. topFirst = topFirst - 1
  107. topOther = topOther - 1
  108. If topFirst < baseFirst Or topOther < baseFirst Then
  109. Exit Do
  110. End If
  111. Loop
  112. firstEndIndex = topFirst
  113. otherEndIndex = topOther
  114. End If
  115. End Sub
  116.  
  117. 'Advance indexes until the next matches are found.
  118. Private Sub FindNextMatch(ByRef first() As Byte, ByRef other() As Byte, ByRef firstStartIndex As Long, _
  119. ByRef firstEndIndex As Long, ByRef otherStartIndex As Long, ByRef otherEndIndex As Long, _
  120. ByRef matchPositionFirst As Long, ByRef matchPositionOther As Long, ByRef matchLength As Long)
  121.  
  122. Dim tempIndex As Long
  123. Dim result As Long
  124. Dim firstIndex As Long
  125. Dim otherIndex As Long
  126.  
  127. For otherIndex = otherStartIndex To otherEndIndex
  128. firstIndex = firstStartIndex
  129. Do Until firstIndex >= firstEndIndex
  130. 'Seek forward in first until there is a match.
  131. Do Until other(otherIndex) = first(firstIndex)
  132. firstIndex = firstIndex + 1
  133. If firstIndex = firstEndIndex Then
  134. Exit Do
  135. End If
  136. Loop
  137. 'Concurrently seek forward in both until a mismatch is found.
  138. tempIndex = otherIndex
  139. Do Until other(tempIndex) <> first(firstIndex)
  140. tempIndex = tempIndex + 1
  141. firstIndex = firstIndex + 1
  142. If firstIndex > firstEndIndex Then
  143. Exit Do
  144. End If
  145. If tempIndex > otherEndIndex Then
  146. Exit Do
  147. End If
  148. Loop
  149. 'Calculate match indexes and length.
  150. result = tempIndex - otherIndex
  151. If result > matchLength Then
  152. matchLength = result
  153. matchPositionOther = otherIndex
  154. matchPositionFirst = firstIndex - matchLength
  155. End If
  156. If matchLength > firstEndIndex - firstIndex Then
  157. Exit Do
  158. End If
  159. Loop
  160. If matchLength + otherIndex > otherEndIndex Then
  161. 'No possible matches left.
  162. Exit For
  163. End If
  164. Next
  165. End Sub
  166.  
  167. 'Returns a comma delimited string of indexes between starting and ending, rebases to 1 base.
  168. Private Function FormatIndexSpanForOutput(ByVal starting As Long, ByVal ending As Long) As String
  169. Dim returnValue As String
  170. If starting = ending Then
  171. returnValue = CStr(ending + 1)
  172. Else
  173. Dim index As Long
  174. For index = starting To ending - 1
  175. returnValue = returnValue & CStr(index + 1) & ","
  176. Next index
  177. If starting < ending Then
  178. returnValue = returnValue & CStr(ending + 1)
  179. End If
  180. End If
  181.  
  182. FormatIndexSpanForOutput = returnValue
  183. End Function
RAW Paste Data