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.