11-30-2022, 04:10 PM
And, if one ever needs to know more than just "Is it a number?", there's always my overengineered NumType function. It'll tell you everything you ever wanted to know about your string and the number types associated with it -- and probably then some!
Code: (Select All)
Const limit = 16
Dim test(limit) As String
Data "123a.3","-123.456","--234","1.23E15","123","dogfood","678.965","54678","-987134","1E15"
Data "&HFF","&B1001111","&O17","&HFF&&","&B12000222","1.E-12"
For i = 1 To limit
Read test(i)
Next
For i = 1 To limit
Print "TEST #"; i; ": "; test(i) + " "
result = NumType(test(i))
If result = 0 Then Print "INVALID: "; NumErr$
If result And 1 Then Print "Valid Unsigned Bit. ";
If result And 2 Then Print "Valid Unsigned Byte. ";
If result And 4 Then Print "Valid Unsigned Integer. ";
If result And 8 Then Print "Valid Unsigned Long. ";
If result And 16 Then Print "Valid Unsigned Integer64. ";
If result And 32 Then Print "Valid Unsigned Bit. ";
If result And 64 Then Print "Valid Signed Byte. ";
If result And 128 Then Print "Valid Signed Integer. ";
If result And 256 Then Print "Valid Signed Long. ";
If result And 512 Then Print "Valid Signed Integer64. ";
If result And 1024 Then Print "Valid Single. ";
If result And 2048 Then Print "Valid Double. ";
If result And 4096 Then Print "Valid Float. ";
If result And 8192 Then Print "Valid Unsigned Offset. ";
If result And 16384 Then Print "Valid Signed Offset. ";
Print
Print
Sleep
Next
Function NumType~% (text$)
Shared NumErr$
Dim TempNum As Integer
temp$ = UCase$(_Trim$(text$))
NumErr$ = "": TempNum = 0
'First look for manually assigned types
r1$ = Right$(temp$, 1): r = 1
r2$ = Left$(Right$(temp$, 2), 1)
Select Case r1$
Case "`"
TestFor = 1 'bit
Case "%"
If r2$ = "%" Then
r = 2
TestFor = 2 'byte
Else
TestFor = 3 'integer
End If
Case "&" 'long, int64, offset
If r2$ = "&" Then
r = 2
TestFor = 5 'int64
ElseIf r2$ = "%" Then
r = 2
TestFor = 9 'offset
Else
TestFor = 4 'long
End If
Case "!" 'single
TestFor = 6
Case "#" 'double, float
If r2$ = "#" Then
r = 2
TestFor = 8 'float
Else
TestFor = 7 'double
End If
Case Else 'there's no set type
TestFor = 0
r = 0
End Select
temp$ = Left$(temp$, Len(temp$) - r) 'strip off the type symbol
Select Case TestFor
Case 1 To 5, 9
r$ = Right$(temp$, 1)
If r$ = "~" Then Unsigned = -1: temp$ = Left$(temp$, Len(temp$) - 1)
End Select
'check for valid prefixes
l$ = Left$(temp$, 2)
Select Case l$
Case "&H"
temp$ = Mid$(temp$, 3)
For i = 1 To Len(temp$)
t$ = Mid$(temp$, i, 1)
Select Case t$
Case "0" To "9", "A" To "F" 'valid
Case Else
NumErr$ = NumErr$ + "Invalid Character (" + t$ + ") encountered. "
End Select
Next
If NumErr$ <> "" Then Exit Function
GoTo evaluateintegers
Case "&B"
temp$ = Mid$(temp$, 3)
For i = 1 To Len(temp$)
t$ = Mid$(temp$, i, 1)
Select Case t$
Case "0", "1" 'only valid bit characters
Case Else
NumErr$ = NumErr$ + "Invalid Character (" + t$ + ") encountered. "
End Select
Next
If NumErr$ <> "" Then Exit Function
GoTo evaluateintegers
Case "&O"
temp$ = Mid$(temp$, 3)
For i = 1 To Len(temp$)
t$ = Mid$(temp$, i, 1)
Select Case t$
Case "0" To "7" 'only valid oct characters
Case Else
NumErr$ = NumErr$ + "Invalid Character (" + t$ + ") encountered. "
End Select
Next
If NumErr$ <> "" Then Exit Function
GoTo evaluateintegers
End Select
'Test for easy integers
'First check for positive/negative values; flag for invalid cases of multiple negation.
If Mid$(temp$, 1, 1) = "-" Then
negative = -1: temp$ = Mid$(temp$, 2) 'strip off the initial negative
ElseIf Mid$(temp$, 1, 1) = "+" Then
temp$ = Mid$(temp$, 2) 'strip off the initial positive
End If
For i = 1 To Len(temp$)
If Mid$(temp$, i, 1) = "-" Then minus = minus + 1
If Mid$(temp$, i, 1) = "+" Then plus = plus + 1
If Mid$(temp$, i, 1) = "." Then period = period + 1 'Go ahead and check for multiple periods while we're at it.
If Mid$(temp$, i, 1) = "E" Or Mid$(temp$, i, 1) = "D" Then
Exponent = Exponent + 1
If Mid$(temp$, i + 1, 1) = "-" Or Mid$(temp$, i + 1, 1) = "+1" Then ExponentSign = -1
End If
Next
If period = 0 And Exponent = 0 Then 'we should only have integers to process
For i = 1 To Len(temp$)
t$ = Mid$(temp$, i, 1)
If t$ < "0" Or t$ > "9" Then NumErr$ = NumErr$ + "Invalid Character (" + t$ + ") encountered. ": Exit Function
Next
GoTo evaluateintegers
End If
'At this point forward, we should only have REAL numbers to process
If Exponent > 1 Then NumErr$ = NumErr$ + "Multiple E/D exponent characters in string. ": Exit Function
If ExponentSign = 0 Then
If minus Then NumErr$ = NumErr$ + "Multiple negative signs (-) encountered. ": Exit Function
If plus Then NumErr$ = NumErr$ + "Multiple negative signs (-) encountered. ": Exit Function
Else
If minus > 1 Then NumErr$ = NumErr$ + "Multiple negative signs (-) encountered. ": Exit Function
If plus > 1 Then NumErr$ = NumErr$ + "Multiple negative signs (-) encountered. ": Exit Function
End If
If period > 1 Then NumErr$ = NumErr$ + "Multiple decimal points (.) encountered. ": Exit Function
If Exponent And period Then
e = InStr(temp$, "E")
If e = 0 Then e = InStr(temp$, "D")
p = InStr(temp$, ".")
If p > e Then NumErr$ = NumErr$ + "Decimal points (.) AFTER E/D exponent encountered. ": Exit Function
End If
For i = 1 To Len(temp$)
t$ = Mid$(temp$, i, 1)
Select Case t$
Case "0" To "9", "-", "+", ".", "D", "E" 'we should have validated all these characters earlier
Case Else 'so anything else is invalid
NumErr$ = NumErr$ + "Invalid Character (" + t$ + ") encountered. ": Exit Function
End Select
Next
If NumErr$ <> "" Then Exit Function
'We should've passed all the error checking by this point -- I think...
evaluateintegers:
t## = Val(text$)
'first compare for all types
If Int(t##) = t## Then
If t## = -1 Or t## = 0 Then TempNum = TempNum Or 32 'signed bit
If t## >= -128 And t## <= 127 Then TempNum = TempNum Or 64 'signed byte
If t## >= -32768 And t## <= 32767 Then TempNum = TempNum Or 128 'signed integer
If t## >= -2147483648 And t## <= 2147483647 Then TempNum = TempNum Or 256 'signed long
If t## >= -9223372036854775808 And t## <= 9223372036854775807 Then
TempNum = TempNum Or 512 'signed integer64
TempNum = TempNum Or 16384 'signed offset
End If
If t## = 1 Or t## = 0 Then TempNum = TempNum Or 1 'unsigned bit
If t## >= 0 And t## <= 255 Then TempNum = TempNum Or 2 'unsigned byte
If t## >= 0 And t## <= 65535 Then TempNum = TempNum Or 4 'unsigned integer
If t## >= 0 And t## <= 4294967295 Then TempNum = TempNum Or 8 'unsigned long
If t## >= 0 And t## <= 18446744073709551615 Then
TempNum = TempNum Or 16 'unsigned integer64
TempNum = TempNum Or 8192 'unsigned offset
End If
End If
If t## >= -2.802597D45 And t## <= 3.402823D+38 Then
TempNum = TempNum Or 1024 'single
End If
If t## >= -4.490656458412465E324 And t## <= 1.797693134862310E+308 Then TempNum = TempNum Or 2048 'double
If t## >= -1.18E4932 And t## <= 1.18E+4932 Then TempNum = TempNum Or 4096 'float
If r Then 'we have specific suffix; only decide if the value is valid for it
TempNum = 0
If Not Unsigned Then 'unsigned
Select Case TestFor
Case 1
If t## = -1 Or t## = 0 Then TempNum = 32 'signed bit
Case 2
If t## >= -128 And t## <= 127 Then TempNum = 64 'signed byte
Case 3
If t## >= -32768 And t## <= 32767 Then TempNum = 128 'signed integer
Case 4
If t## >= -2147483648 And t## <= 2147483647 Then TempNum = 256 'signed long
Case 5, 9
If t## >= -9223372036854775808 And t## <= 9223372036854775807 Then
If TestFor = 5 Then
TempNum = 512 'signed integer64
Else
TempNum = 16384 'signed offset
End If
End If
Case 6
If t## >= -2.802597E-45 And t## <= 3.402823E+38 Then TempNum = 1024 'single
Case 7
If t## >= -4.490656458412465E-324 And t## <= 1.797693134862310E+308 Then TempNum = 2048 'double
Case 9
If t## >= -1.18E-4932 And t## <= 1.18E+4932 Then TempNum = 4096 'float
End Select
Else
Select Case TestFor
Case 1
If t## = 0 Or t## = 1 Then TempNum = 1 'unsigned bit
Case 2
If t## >= 0 And t## <= 255 Then TempNum = 2 'unsigned byte
Case 3
If t## >= 0 And t## <= 65535 Then TempNum = 4 'unsigned integer
Case 4
If t## >= 0 And t## <= 4294967295 Then TempNum = 8 'unsigned long
Case 5, 9
If t## >= 0 And t## <= 18446744073709551615 Then
If TestFor = 5 Then
TempNum = 16 'unsigned integer64
Else
TempNum = 8192 'unsigned offset
End If
End If
End Select
End If
If TempNum = 0 Then NumErr$ = "Invalid Suffix. "
End If
NumType = TempNum
End Function