'Non-UI application (console / server application)
#Region Project Attributes
#CommandLineArgs:
#MergeLibraries: True
#End Region
Sub Process_Globals
End Sub
Sub AppStart (Args() As String)
Dim TestCodes() As String = Array As String( _
"H2345", "2V12345", "01f3b", "60123", "X7999", "7h12", "B2122", _
"B3210", "F2122", "F9999", "FADED", "DECAF", _
"17HM12", "14HM987", "12HM7", "12HM777", _
"4FOUR", "4ZZZZ", "9ZZZZ", _
"A103", "NS2600", "5443", "P2022", _
"7R85", "7T85" _
)
Dim StartTime As Long = DateTime.Now
For Each TestCode In TestCodes
Log("Code """ & TestCode & """ is in ranges " & StringListToNiceString(CodeIsInRanges(TestCode)))
Next
Dim EndTime As Long = DateTime.Now
Log(TestCodes.Length & " matchings took a total of " & (EndTime - StartTime) & " milliseconds (including log output)")
End Sub
Sub PadLeft(S As String, L As Int, PadChar As String) As String
Dim SB As StringBuilder
SB.Initialize
For I = S.Length + 1 To L
SB.Append(PadChar)
Next
Return SB.Append(S).ToString
End Sub
Sub StringListToArray(L As List) As String()
Dim A(L.Size) As String
For I = 0 To L.Size - 1
A(I) = L.Get(I)
Next
Return A
End Sub
Sub StringArrayToNiceString(A() As String) As String
Return StringArrayToNiceString2(A, "[", """",", ", "]")
End Sub
Sub StringArrayToNiceString2(A() As String, BeforeChar As String, QuoteChar As String, CommaChar As String, AfterChar As String) As String
Dim SB As StringBuilder
SB.Initialize
SB.Append(BeforeChar)
For I = 0 To A.Length - 1
If I > 0 Then
SB.Append(CommaChar)
End If
SB.Append(QuoteChar)
SB.Append(A(I))
SB.Append(QuoteChar)
Next
SB.Append(AfterChar)
Return SB.ToString
End Sub
Sub StringListToNiceString(L As List) As String
Return StringListToNiceString2(L, "{", """", ", ", "}")
End Sub
Sub StringListToNiceString2(L As List, BeforeChar As String, QuoteChar As String, CommaChar As String, AfterChar As String) As String
Dim SB As StringBuilder
SB.Initialize
SB.Append(BeforeChar)
For I = 0 To L.Size - 1
If I > 0 Then
SB.Append(CommaChar)
End If
SB.Append(QuoteChar)
SB.Append(L.Get(I))
SB.Append(QuoteChar)
Next
SB.Append(AfterChar)
Return SB.ToString
End Sub
Sub CodeToFields(Code As String) As String()
Dim FieldList As List
FieldList.Initialize
Dim M As Matcher = Regex.Matcher("([A-Z]*)([0-9]*)", Code.ToUpperCase)
Do While M.Find
If M.Group(0).Length > 0 Then
FieldList.Add(M.Group(1))
FieldList.Add(M.Group(2))
End If
Loop
'''Log(Code & " ==> " & StringListToNiceString(FieldList))
Return StringListToArray(FieldList)
End Sub
Sub CodeIsInRanges(Code As String) As List
Dim CodeSeriesList As List = GetCodeSeriesList
Dim L As List
L.Initialize
For Each Range As String In CodeSeriesList
If CodeIsInRange(Code, Range) Then
L.Add(Range)
End If
Next
Return L
End Sub
Sub CodeIsInRange(Code As String, Range As String) As Boolean
If Code.Length = 0 Then
Return False 'not really an error, could reasonably also return True
Else If Range.Length = 0 Then
Log("error 131 on range """ & Range & """")
Return False
End If
Dim RangeWithoutClarifier As String = Regex.Split("\ ", Range)(0)
If RangeWithoutClarifier.Length < 3 Then 'should be at least three characters eg a-b
Log("error 171 on range """ & Range & """")
Return False
End If
Dim LowerUpper() As String = Regex.Split("\-", RangeWithoutClarifier)
If LowerUpper.Length <> 2 Then
Log("error 49")
Return False
End If
If LowerUpper(0).Length = 0 Then
Log("error 134 on range """ & Range & """")
Return False
else if LowerUpper(1).Length = 0 Then
Log("error 136 on range """ & Range & """")
Return False
else if LowerUpper(0).Length > LowerUpper(1).Length Then
Log("error 138 on range """ & Range & """")
Return False
End If
If Code.Length < LowerUpper(0).Length Then 'code should be at least as long as the lower bound
Return False
else if Code.Length > LowerUpper(1).Length Then 'and no longer than the upper bound
Return False
End If
If Range.ToUpperCase.CompareTo("AA00-7T51") = 0 Then
Return CodeIsInRangeXXN(Code, LowerUpper(0), LowerUpper(1))
else if Range.ToUpperCase.CompareTo("00000-FFFFF") = 0 Then
Return CodeIsInRangeHex(Code, LowerUpper(0), LowerUpper(1))
Else 'default
Return CodeIsInRangeAlphaNumeric(Code, LowerUpper(0), LowerUpper(1), 0)
End If
End Sub
Sub CodeIsInRangeAlphaNumeric(Code As String, LowerBound As String, UpperBound As String, FieldGroupingType As Int) As Boolean
'already know that:
' code, lowerbound and upperbound are non-blank
' upperbound longer than lowerbound
' code length is lowerbound length .. upperbound length
Dim CodeFields() As String = CodeToFields(Code)
Dim LowerFields() As String = CodeToFields(LowerBound)
Dim UpperFields() As String = CodeToFields(UpperBound)
If CodeFields.Length = 0 Or LowerFields.Length = 0 Or UpperFields.Length = 0 Then 'should never happen, but just in case...
Return False
Else If LowerFields.Length <> CodeFields.Length Or UpperFields.Length <> CodeFields.Length Then
Return False
End If
'check range field lengths
For I = 0 To CodeFields.Length - 1 Step 2 'even fields are alphabetic, and their...
If LowerFields(I).Length <> UpperFields(I).Length Then 'lower and upper bounds must be same length
Log(StringArrayToNiceString(CodeFields))
Log(StringArrayToNiceString(LowerFields))
Log(StringArrayToNiceString(UpperFields))
Log("error 188 on """ & LowerFields(I) & """-""" & UpperFields(I) & """")
Return False
End If
Next
For I = 1 To CodeFields.Length - 1 Step 2 'odd fields are numeric, and their...
If LowerFields(I).Length > UpperFields(I).Length Then 'lower bound can't be longer than upper bound
Log("error 195 on """ & LowerFields(I) & """-""" & UpperFields(I) & """")
Return False
End If
Next
'check code field lengths
For I = 0 To CodeFields.Length - 1
If CodeFields(I).Length < LowerFields(I).Length Then
Return False
else if CodeFields(I).Length > UpperFields(I).Length Then
Return False
End If
Next
'special case for fixed letter fields
For I = 0 To CodeFields.Length - 1 Step 2
If LowerFields(I).CompareTo(UpperFields(I)) = 0 Then
If CodeFields(I).CompareTo(LowerFields(I)) <> 0 Then
Return False
End If
End If
Next
'pad numbers to be same length so that string comparisons work for numbers
For I = 1 To CodeFields.Length - 1 Step 2 'only numeric fields need padding
LowerFields(I) = PadLeft(LowerFields(I), UpperFields(I).Length, "0")
CodeFields(I) = PadLeft(CodeFields(I), UpperFields(I).Length, "0")
Next
Dim CheckLowerFlag As Boolean = True
Dim CheckUpperFlag As Boolean = True
For I = 0 To CodeFields.Length - 1
If (FieldGroupingType = 1) Or (FieldGroupingType = 2 And Bit.And(I, 1) = 0) Then
CheckLowerFlag = True
CheckUpperFlag = True
End If
If CheckLowerFlag Then
Dim TempCompareResult As Int = CodeFields(I).CompareTo(LowerFields(I))
If TempCompareResult < 0 Then
Return False
else if TempCompareResult > 0 Then
CheckLowerFlag = False
End If
End If
If CheckUpperFlag Then
Dim TempCompareResult As Int = CodeFields(I).CompareTo(UpperFields(I))
If TempCompareResult > 0 Then
Return False
else if TempCompareResult < 0 Then
CheckUpperFlag = False
End If
End If
Next
Return True 'if not knocked out above, then must be in range
End Sub
'code format XXN:
' first two characters are base-36 A..Z 0..9
' remaining characters are base-10 0..9
Sub CodeToValueXXN(Code As String) As Int
If Code.Length < 1 Or Code.Length > 8 Then
Log("Error 220 for code """ & Code & """")
Return -1
End If
Dim V As Int = 0
For I = 0 To Code.Length - 1
If I = 0 Or I = 1 Then
Dim DigitBase As Int = 36
Dim DigitValue As Int = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789".IndexOf(Code.SubString2(I, I + 1).ToUpperCase)
Else
Dim DigitBase As Int = 10
Dim DigitValue As Int = "0123456789".IndexOf(Code.SubString2(I, I + 1))
End If
If DigitValue = -1 Then
Return -1
End If
V = V * DigitBase + DigitValue
Next
Return V
End Sub
Sub CodeIsInRangeXXN(Code As String, LowerBound As String, UpperBound As String) As Boolean
If LowerBound.Length <> Code.Length Or UpperBound.Length <> Code.Length Then
Log("error 359 for """ & Code & """ / """ & LowerBound & """ / """ & UpperBound & """")
End If
Dim CodeValue As Int = CodeToValueXXN(Code)
Dim LowerValue As Int = CodeToValueXXN(LowerBound)
Dim UpperValue As Int = CodeToValueXXN(UpperBound)
If CodeValue = -1 Or LowerValue = -1 Or UpperValue = -1 Then
Return False
End If
Return (CodeValue >= LowerValue And CodeValue <= UpperValue)
End Sub
'code format hexadecimal:
Sub CodeToValueHex(Code As String) As Int
If Code.Length < 1 Or Code.Length > 7 Then
Log("Error 377 for code """ & Code & """")
Return -1
End If
Dim V As Int = 0
For I = 0 To Code.Length - 1
Dim DigitValue As Int = "0123456789ABCDEF".IndexOf(Code.SubString2(I, I + 1).ToUpperCase)
If DigitValue = -1 Then
Return -1
End If
V = V * 16 + DigitValue
Next
Return V
End Sub
Sub CodeIsInRangeHex(Code As String, LowerBound As String, UpperBound As String) As Boolean
If LowerBound.Length <> Code.Length Or UpperBound.Length <> Code.Length Then
Log("error 359 for """ & Code & """ / """ & LowerBound & """ / """ & UpperBound & """")
End If
Dim CodeValue As Int = CodeToValueHex(Code)
Dim LowerValue As Int = CodeToValueHex(LowerBound)
Dim UpperValue As Int = CodeToValueHex(UpperBound)
If CodeValue = -1 Or LowerValue = -1 Or UpperValue = -1 Then
'error already notified by CodeToValueXXNN()
Return False
End If
Return (CodeValue >= LowerValue And CodeValue <= UpperValue)
End Sub
Sub GetCodeSeriesList() As List
Dim L As List
L.Initialize
'''L.Add("Series")
L.Add("0-5928")
L.Add("0000-6999")
L.Add("00001-13284")
L.Add("0001-0355")
L.Add("0001-2000")
L.Add("0001-2000")
L.Add("0001-2300")
L.Add("0001-3000")
L.Add("0001-4000")
L.Add("0001X-1706X")
L.Add("001-200")
L.Add("001-700")
L.Add("001R-200R")
L.Add("0AAAA-9XXXX")
L.Add("0K001-0N718")
L.Add("1-17850")
L.Add("1-1988")
L.Add("1-2000")
L.Add("1-22185")
L.Add("1-3001")
L.Add("1-3679")
L.Add("1-6000")
L.Add("1-8100")
L.Add("10001-11500")
L.Add("10001-15000")
L.Add("1001-2174")
L.Add("1001-2252")
L.Add("1003591-1006700")
L.Add("10100-12283")
L.Add("101A501-304E579")
L.Add("00000-FFFFF") 'was "1234567890abcdef - Any 5 digits"
L.Add("14515-15014")
L.Add("18100-19617")
L.Add("19001-19420")
L.Add("1HM1-99HM99")
L.Add("1NF1-99NF99")
L.Add("1V00001-5V12295")
L.Add("20001-32000")
L.Add("2002001-2003500")
L.Add("20100-23284")
L.Add("25001-26200")
L.Add("2S0001-2S2675")
L.Add("30001-31200")
L.Add("30001-37850")
L.Add("3001-4000")
L.Add("3001-4481")
L.Add("30010-32009")
L.Add("3501-6700")
L.Add("40000-49999")
L.Add("40001-41518")
L.Add("4001-9001")
L.Add("50000-69999")
L.Add("50001-51308")
L.Add("5001-8442")
L.Add("60000-62113")
L.Add("60001-60400")
L.Add("6001-7000")
L.Add("6001-7001")
L.Add("6001-8110")
L.Add("6500-7733")
L.Add("65001-67012")
L.Add("70000-75928")
L.Add("700001-703000")
L.Add("7001-9000")
L.Add("701-900")
L.Add("73000-73999")
L.Add("80000-80999")
L.Add("80000-89999")
L.Add("80001-81500")
L.Add("8001-9000")
L.Add("8001-9554")
L.Add("8100-9113")
L.Add("A0001-A1000")
L.Add("A101-A800")
L.Add("A6001-A7000")
L.Add("A7001-A8500")
L.Add("AA00-7T51")
L.Add("AB6001-AB6891")
L.Add("B0001-B2608")
L.Add("B0001-B3000")
L.Add("B1001-B2200 New")
L.Add("B1001-B2200 Old")
L.Add("B101-B800")
L.Add("B5001-B6200")
L.Add("B5001-B6200")
L.Add("B8001-B9000")
L.Add("B8001-B9000")
L.Add("BC0001-BC2865")
L.Add("BH010001-BH241450")
L.Add("C0001-C2900")
L.Add("C1001-C3500")
L.Add("C1001-C3500")
L.Add("C7001-C8000")
L.Add("C8001-C9000")
L.Add("CB0001-CB0709")
L.Add("CC0001-CC1000")
L.Add("CC4001-CC4650")
L.Add("CD0001-CD1000")
L.Add("CD4001-CD4650")
L.Add("D00-D99")
L.Add("D0001-D2000")
L.Add("D0001-D3000")
L.Add("D1001-D3500")
L.Add("D4001-D5200")
L.Add("D4501-D4542")
L.Add("DE1-DE11210")
L.Add("DH0001-DH4000")
L.Add("DH6001-DH8000")
L.Add("E0001-E2500")
L.Add("E2001-E3000")
L.Add("E4001-E5000")
L.Add("E5000-E5999")
L.Add("E5001-E7700")
L.Add("E6001-E7000")
L.Add("E8000-E8999")
L.Add("E8001-E9000")
L.Add("F0001-F1619")
L.Add("F0001-F1691")
L.Add("F0001-F2500")
L.Add("F0001-F2500")
L.Add("FA0-FA1863")
L.Add("G000-G3631")
L.Add("G0001-G2377")
L.Add("G0001-G2500")
L.Add("G101-G598")
L.Add("G8001-G9000")
L.Add("H0001-H2500")
L.Add("H0001-H2500")
L.Add("H0001-H3000")
L.Add("H0001-H3988")
L.Add("H5001-H7000")
L.Add("HA00000001-HA00008100")
L.Add("HA00000010-HA00081009")
L.Add("HB1-HB2988")
L.Add("HB3001-HB5000")
L.Add("HK0001-HK2500")
L.Add("HM1-HM1200")
L.Add("HM2501-HM3500")
L.Add("HM4001-HM7350")
L.Add("HM6001-HM7110")
L.Add("HS2001-HS3500")
L.Add("HV1-HV854")
L.Add("HV1001-HV1918")
L.Add("HV2001-HV2830")
L.Add("HV3001-HV3890")
L.Add("HV4001-HV5151")
L.Add("HV6001-HV7086")
L.Add("HV7101-HV8154")
L.Add("HV8201-HV9282")
L.Add("HY6001-HY8130")
L.Add("I0001-I2608")
L.Add("J00-U39")
L.Add("J0001-J1200")
L.Add("J0001-J2500")
L.Add("JA1001-JA3500")
L.Add("K0001-K1000")
L.Add("K0001-K1000")
L.Add("K0001-K1000")
L.Add("K0001-K2500")
L.Add("K5001-K8276")
L.Add("KE0001-KE2500")
L.Add("KG0001-KG2500")
L.Add("KH0001-KH1000")
L.Add("KU0001-KU2608")
L.Add("L000-L999")
L.Add("L0001-L1037")
L.Add("L0001-L1200")
L.Add("L1-L3580")
L.Add("L8001-L10000")
L.Add("LK0001-LK2500")
L.Add("M0001-M1200")
L.Add("M0001-M2500")
L.Add("M0001-M2500")
L.Add("M0001-M2618")
L.Add("M1001-M3500")
'''L.Add("Mixed")
'''L.Add("Mixed")
L.Add("N0001-N2500")
L.Add("N001-N200")
L.Add("N001R-N200R")
L.Add("N225-N814")
L.Add("N5001-N7000")
L.Add("N6001-N7000")
L.Add("NC1001-NC3040")
L.Add("NF1-NF1200")
L.Add("NM2501-NM3500")
L.Add("NS2001-NS3500")
L.Add("NSP4000-NSP4999")
L.Add("NSP7001-NSP9000")
L.Add("O0001-O5000")
L.Add("O5000-O6999")
L.Add("P0001-P2390")
L.Add("P0001-P2500")
L.Add("P0001-P2500")
L.Add("R0001-R1000")
L.Add("S0001-S2500") 'was "S0001-2500"
L.Add("S0001-S1000")
L.Add("S0001-S1000")
L.Add("S0001-S2000")
L.Add("S0001-S2878")
L.Add("S000A-S999K")
L.Add("S4001-S5200")
L.Add("S5298-S6300")
L.Add("S8001-S9000")
L.Add("SC0001-SC2500")
L.Add("SK0001-SK1000")
L.Add("T0001-T1000")
L.Add("T0001-T1000")
L.Add("T0001-T2500")
L.Add("T0001-T2500")
L.Add("T0001-T3000")
L.Add("T1-T26789") 'was "T1-26789"
L.Add("T1-T3456") 'was "T1-3456"
L.Add("T1-T1200")
L.Add("T1-T1200")
L.Add("T1-T1200")
L.Add("T1-T2330")
L.Add("T1001-T3500")
L.Add("T5-T3456") 'was "T5-3456"
L.Add("T5001-T7000")
L.Add("U0001-U2608")
L.Add("U1-U2000")
L.Add("V0000-V1999")
L.Add("V0001-V2500")
L.Add("V0001-V5718")
L.Add("V1-V1200")
L.Add("V1-V3056")
L.Add("V2001-V3200")
L.Add("V5001-V8058")
L.Add("VN0-VN1999")
L.Add("W0001-W2409")
L.Add("W1-W9640")
L.Add("WC1001-WC3500")
L.Add("WD1001-WD3500")
L.Add("X0001-X1000")
L.Add("X0001-X2245")
L.Add("X0001-X2248")
L.Add("X0001-X8000")
L.Add("X1001-X3500")
L.Add("X8001-X9000")
L.Add("Y2001-Y3000")
L.Add("Y7001-Y8200")
L.Add("Z0001-Z6314")
L.Add("Z2001-Z9416")
L.Add("Z5001-Z6000")
Return L
End Sub
