<-- Previous || Up || Next -->

Unit Duplicate Test Function
Units Class

Function UnitDuplicateTest( _
    ) As Integer
    ' Look for measurement definitions whose Code and/or space-stripped Code is the same as that of another unit.
    ' Duplicate unit codes should never occur, and duplicate space-stripped codes should normally be removed before
    ' definitions are made publicly available.

    Const strFn = "UnitDuplicateTest"
    Debug.Print strFn & ": Info: Begin " & Time

    ' Assume that the definitions are valid; will reset return value to False when
    ' and if errors are found in the definitions.
    UnitDuplicateTest = True

    InitializeMaybe

    Dim lngCurUnit As Long
    For lngCurUnit = 1 To GetUnitCount
        If estBE.TrueEveryNSeconds(30) Then
            Debug.Print strFn & ": Info: checking unit #" & lngCurUnit & " of " & GetUnitCount & " " & Time
        End If

        Dim strCurCode As String
        Dim strCurCodeStr As String
        Dim strCurName As String
        Dim dblCurConst As Double
        Dim strCurDef As String

        If Not GetUnit(lngCurUnit, strCurCode, strCurCodeStr, strCurName, dblCurConst, strCurDef) Then
            UnitDuplicateTest = False
            Exit Function
        End If

        Dim lngOtherUnit As Long
        For lngOtherUnit = lngCurUnit + 1 To GetUnitCount
            Dim strOthCode As String
            Dim strOthCodeStr As String
            Dim strOthName As String
            Dim dblOthConst As Double
            Dim strOthDef As String

            If Not GetUnit(lngOtherUnit, strOthCode, strOthCodeStr, strOthName, dblOthConst, strOthDef) Then
                UnitDuplicateTest = False
                Exit Function
            End If

            If StrComp(strCurCode, strOthCode, vbBinaryCompare) = 0 Then
                ' The Code of two units are the same--major problems!
                Dim strMsg As String
                strMsg = ""
                strMsg = strMsg & strFn & ": Error: Binary Duplicate "
                strMsg = strMsg & strCurCode & " (" & strCurName & "; " & dblCurConst & " " & strCurDef & ")"
                strMsg = strMsg & " == "
                strMsg = strMsg & strOthCode & " (" & strOthName & "; " & dblOthConst & " " & strOthDef & ")"
                Debug.Print strMsg
                UnitDuplicateTest = False
            ElseIf StrComp(strCurCodeStr, strOthCodeStr, vbBinaryCompare) = 0 Then
                ' The space-stripped Code of two units are the same--will lead to inconsistent results if either one is used.
                strMsg = ""
                strMsg = strMsg & strFn & ": Error: Binary Stripped Duplicate "
                strMsg = strMsg & strCurCodeStr & " (" & strCurCode & "; " & dblCurConst & " " & strCurDef & ")"
                strMsg = strMsg & " == "
                strMsg = strMsg & strOthCodeStr & " (" & strOthCode & "; " & dblOthConst & " " & strOthDef & ")"
                Debug.Print strMsg
                UnitDuplicateTest = False
            End If
        Next lngOtherUnit
    Next lngCurUnit

    Debug.Print strFn & ": Info: End " & Time
End Function

Copyright 1996-1999 Entisoft
Entisoft Tools is a trademark of Entisoft.