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 FunctionCopyright 1996-1999 Entisoft
Entisoft Tools is a trademark of Entisoft.