String Comparison Percent

Original - ASP Code Dim arrLetters1 Dim arrLetters2 Function CompareString(String1, String2) Dim intLength1 Dim intLength2 Dim x Dim dblResult If UCase(String1) = UCase(String2) Then dblResult = 1 Else intLength1 = Len(String1) intLength2 = Len(String2) If intLength1 = 0 Or intLength2 = 0 Then dblResult = 0 Else ReDim arrLetters1(intLength1 - 1) ReDim arrLetters2(intLength2 - 1) For x = LBound(arrLetters1) To UBound(arrLetters1) arrLetters1(x) = Asc(UCase(Mid(String1, x + 1, 1))) Next For x = LBound(arrLetters2) To UBound(arrLetters2) arrLetters2(x) = Asc(UCase(Mid(String2, x + 1, 1))) Next dblResult = SubSim(1, intLength1, 1, intLength2) / (intLength1 + intLength2) * 2 End If End If CompareString = dblResult End Function Function SubSim(intStart1, intEnd1, intStart2, intEnd2) Dim y Dim z Dim ns1 Dim ns2 Dim i Dim intMax If (intStart1 > intEnd1) Or (intStart2 > intEnd2) Or (intStart1 <= 0) Or (intStart2 <= 0) Then Exit Function End If For y = intStart1 To intEnd1 For z = intStart1 To intEnd2 i = 0 Do Until arrLetters1(y - 1 + i) <> arrLetters2(z - 1 + i) i = i + 1 If i > intMax Then ns1 = y ns2 = z intMax = i End If If ((y + i) > intEnd1) Or ((z + i) > intEnd2) Then Exit Do End If Loop Next Next intMax = intMax + SubSim(ns1 + intMax, intEnd1, ns2 + intMax, intEnd2) intMax = intMax + SubSim(intStart1, ns1 - 1, intStart2, ns2 - 1) SubSim = intMax End Function

Dim arrLetters1
Dim arrLetters2
 
Function CompareString(String1, String2)
    Dim intLength1
    Dim intLength2
    Dim x
    Dim dblResult
 
 
    If UCase(String1) = UCase(String2) Then
        dblResult = 1
    Else
        intLength1 = Len(String1)
        intLength2 = Len(String2)
 
 
        If intLength1 = 0 Or intLength2 = 0 Then
            dblResult = 0
        Else
            ReDim arrLetters1(intLength1 - 1)
            ReDim arrLetters2(intLength2 - 1)
 
            For x = LBound(arrLetters1) To UBound(arrLetters1)
                arrLetters1(x) = Asc(UCase(Mid(String1, x + 1, 1)))
            Next
 
            For x = LBound(arrLetters2) To UBound(arrLetters2)
                arrLetters2(x) = Asc(UCase(Mid(String2, x + 1, 1)))
            Next
 
            dblResult = SubSim(1, intLength1, 1, intLength2) / (intLength1 + intLength2) * 2
        End If
    End If
 
    CompareString = dblResult
End Function
 
 
Function SubSim(intStart1, intEnd1, intStart2, intEnd2)
    Dim y
    Dim z
    Dim ns1
    Dim ns2
    Dim i
    Dim intMax
 
    If (intStart1 > intEnd1) Or (intStart2 > intEnd2) Or (intStart1 <= 0) Or (intStart2 <= 0) Then
        Exit Function
    End If
 
    For y = intStart1 To intEnd1
        For z = intStart1 To intEnd2
            i = 0
 
            Do Until arrLetters1(y - 1 + i) <> arrLetters2(z - 1 + i)
                i = i + 1
 
                If i > intMax Then
                    ns1 = y
                    ns2 = z
                    intMax = i
                End If
 
                If ((y + i) > intEnd1) Or ((z + i) > intEnd2) Then
                    Exit Do
                End If
            Loop
        Next
    Next
 
    intMax = intMax + SubSim(ns1 + intMax, intEnd1, ns2 + intMax, intEnd2)
    intMax = intMax + SubSim(intStart1, ns1 - 1, intStart2, ns2 - 1)
 
    SubSim = intMax
End Function