Barcode is hidden in reporting services - vb.net

I have a report which carries a barcode , at the time of the Visual Studio preview it looks perfectly but when published to the server reporting services ( WEB ) does not show me the barcode as if hidden
This is the code I use within the report :
Public Shared Function Code39(ByVal stringText As String) As Byte()
Dim result As Byte() = Nothing
Try
result = GenerateImage("Code 3 de 9", StringToBarcode39String(stringText))
Catch ex As Exception
End Try
Return result
End Function
Public Shared Function Code128(ByVal stringText As String) As Byte()
Dim result As Byte() = Nothing
Try
result = GenerateImage("Code 128", StringToBarcode128String(stringText))
Catch ex As Exception
End Try
Return result
End Function
Public Shared Function GenerateImage(ByVal fontName As String, ByVal stringText As String) As Byte()
Dim oGraphics As System.Drawing.Graphics
Dim barcodeSize As System.Drawing.SizeF
Dim ms As System.IO.MemoryStream
Using font As New System.Drawing.Font(New System.Drawing.FontFamily(fontName), 36)
Using tmpBitmap As New System.Drawing.Bitmap(1, 1, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
oGraphics = System.Drawing.Graphics.FromImage(tmpBitmap)
oGraphics.TextRenderingHint = System.Drawing.Text.TextRenderingHint.SingleBitPerPixel
barcodeSize = oGraphics.MeasureString(stringText, font)
oGraphics.Dispose()
End Using
Using newBitmap As New System.Drawing.Bitmap(barcodeSize.Width, barcodeSize.Height, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
oGraphics = System.Drawing.Graphics.FromImage(newBitmap)
oGraphics.TextRenderingHint = System.Drawing.Text.TextRenderingHint.SingleBitPerPixel
Using oSolidBrushWhite As New System.Drawing.SolidBrush(System.Drawing.Color.White)
Using oSolidBrushBlack As New System.Drawing.SolidBrush(System.Drawing.Color.Black)
oGraphics.FillRectangle(oSolidBrushWhite, New System.Drawing.Rectangle(0, 0, barcodeSize.Width, barcodeSize.Height))
oGraphics.DrawString(stringText, font, oSolidBrushBlack, 0, 0)
End Using
End Using
ms = New System.IO.MemoryStream()
newBitmap.Save(ms, System.Drawing.Imaging.ImageFormat.Png)
End Using
End Using
Return ms.ToArray()
End Function
Public Shared Function StringToBarcode128String(ByVal value As String) As String
' Parameters : a string
' Return : a string which give the bar code when it is dispayed with CODE128.TTF font
' : an empty string if the supplied parameter is no good
Dim charPos As Integer, minCharPos As Integer
Dim currentChar As Integer, checksum As Integer
Dim isTableB As Boolean = True, isValid As Boolean = True
Dim returnValue As String = String.Empty
If value.Length > 0 Then
' Check for valid characters
For charCount As Integer = 0 To value.Length - 1
'currentChar = char.GetNumericValue(value, charPos);
currentChar = AscW(Char.Parse(value.Substring(charCount, 1)))
If Not (currentChar >= 32 AndAlso currentChar <= 126) Then
isValid = False
Exit For
End If
Next
' Barcode is full of ascii characters, we can now process it
If isValid Then
charPos = 0
While charPos < value.Length
If isTableB Then
' See if interesting to switch to table C
' yes for 4 digits at start or end, else if 6 digits
If charPos = 0 OrElse charPos + 4 = value.Length Then
minCharPos = 4
Else
minCharPos = 6
End If
minCharPos = IsNumber(value, charPos, minCharPos)
If minCharPos < 0 Then
' Choice table C
If charPos = 0 Then
' Starting with table C
' char.ConvertFromUtf32(210);
returnValue = (ChrW(210)).ToString()
Else
' Switch to table C
returnValue = returnValue & (ChrW(204)).ToString()
End If
isTableB = False
Else
If charPos = 0 Then
' Starting with table B
' char.ConvertFromUtf32(209);
returnValue = (ChrW(209)).ToString()
End If
End If
End If
If Not isTableB Then
' We are on table C, try to process 2 digits
minCharPos = 2
minCharPos = IsNumber(value, charPos, minCharPos)
If minCharPos < 0 Then
' OK for 2 digits, process it
currentChar = Integer.Parse(value.Substring(charPos, 2))
currentChar = IIf(currentChar < 95, currentChar + 32, currentChar + 105) ''
returnValue = returnValue & (ChrW(currentChar)).ToString()
charPos += 2
Else
' We haven't 2 digits, switch to table B
returnValue = returnValue & (ChrW(205)).ToString()
isTableB = True
End If
End If
If isTableB Then
' Process 1 digit with table B
returnValue = returnValue & value.Substring(charPos, 1)
charPos += 1
End If
End While
' Calculation of the checksum
checksum = 0
For [loop] As Integer = 0 To returnValue.Length - 1
currentChar = AscW(Char.Parse(returnValue.Substring([loop], 1)))
currentChar = IIf(currentChar < 127, currentChar - 32, currentChar - 105)
If [loop] = 0 Then
checksum = currentChar
Else
checksum = (checksum + ([loop] * currentChar)) Mod 103
End If
Next
' Calculation of the checksum ASCII code
checksum = IIf(checksum < 95, checksum + 32, checksum + 105)
' Add the checksum and the STOP
returnValue = returnValue & (ChrW(checksum)).ToString() & (ChrW(211)).ToString()
End If
End If
Return returnValue
End Function
Private Shared Function IsNumber(ByVal InputValue As String, ByVal CharPos As Integer, ByVal MinCharPos As Integer) As Integer
' if the MinCharPos characters from CharPos are numeric, then MinCharPos = -1
MinCharPos -= 1
If CharPos + MinCharPos < InputValue.Length Then
While MinCharPos >= 0
If AscW(Char.Parse(InputValue.Substring(CharPos + MinCharPos, 1))) < 48 OrElse AscW(Char.Parse(InputValue.Substring(CharPos + MinCharPos, 1))) > 57 Then
Exit While
End If
MinCharPos -= 1
End While
End If
Return MinCharPos
End Function
Public Shared Function StringToBarcode39String(ByVal value As String, Optional ByVal addChecksum As Boolean = False) As String
' Parameters : a string
' Return : a string which give the bar code when it is dispayed with CODE128.TTF font
' : an empty string if the supplied parameter is no good
Dim isValid As Boolean = True
Dim currentChar As Char
Dim returnValue As String = String.Empty
Dim checksum As Integer = 0
If value.Length > 0 Then
'Check for valid characters
For CharPos As Integer = 0 To value.Length - 1
currentChar = Char.Parse(value.Substring(CharPos, 1))
If Not ((currentChar >= "0"c AndAlso currentChar <= "9"c) OrElse (currentChar >= "A"c AndAlso currentChar <= "Z"c) OrElse currentChar = " "c OrElse currentChar = "-"c OrElse currentChar = "."c OrElse currentChar = "$"c OrElse currentChar = "/"c OrElse currentChar = "+"c OrElse currentChar = "%"c) Then
isValid = False
Exit For
End If
Next
If isValid Then
' Add start char
returnValue = "*"
' Add other chars, and calc checksum
For CharPos As Integer = 0 To value.Length - 1
currentChar = Char.Parse(value.Substring(CharPos, 1))
returnValue += currentChar.ToString()
If currentChar >= "0"c AndAlso currentChar <= "9"c Then
checksum = checksum + AscW(currentChar) - 48
ElseIf currentChar >= "A"c AndAlso currentChar <= "Z"c Then
checksum = checksum + AscW(currentChar) - 55
Else
Select Case currentChar
Case "-"c
checksum = checksum + AscW(currentChar) - 9
Exit Select
Case "."c
checksum = checksum + AscW(currentChar) - 9
Exit Select
Case "$"c
checksum = checksum + AscW(currentChar) + 3
Exit Select
Case "/"c
checksum = checksum + AscW(currentChar) - 7
Exit Select
Case "+"c
checksum = checksum + AscW(currentChar) - 2
Exit Select
Case "%"c
checksum = checksum + AscW(currentChar) + 5
Exit Select
Case " "c
checksum = checksum + AscW(currentChar) + 6
Exit Select
End Select
End If
Next
' Calculation of the checksum ASCII code
If addChecksum Then
checksum = checksum Mod 43
If checksum >= 0 AndAlso checksum <= 9 Then
returnValue += (ChrW(checksum + 48)).ToString()
ElseIf checksum >= 10 AndAlso checksum <= 35 Then
returnValue += (ChrW(checksum + 55)).ToString()
Else
Select Case checksum
Case 36
returnValue += "-"
Exit Select
Case 37
returnValue += "."
Exit Select
Case 38
returnValue += " "
Exit Select
Case 39
returnValue += "$"
Exit Select
Case 40
returnValue += "/"
Exit Select
Case 41
returnValue += "+"
Exit Select
Case 42
returnValue += "%"
Exit Select
End Select
End If
End If
' Add stop char
returnValue += "*"
End If
End If
Return returnValue
End Function
Do I use assemblies , And the barcode image is kind

Could it be that on the server the barcode font is missing?

Related

How can I get result from string formula as integer

How I can get result value from this string formula :
Dim Formula As String
Formula = "((5000 / 30) * (22 + 6)) + ((5000 / 30 / 8) * (20))"
Dim Result As Integer
Result = ?????
How can I get an integer result value? It's 5083.33
A bit simpler - use the .Compute method of the DataTable
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim dt As New DataTable
Dim r = dt.Compute("((5000 / 30) * (22 + 6)) + ((5000 / 30 / 8) * (20))", Nothing)
Debug.Print(r.ToString)
End Sub
Result in Immediate Window
5083.33333333333
Thanks every body,
I got the CODE right now as following :-
Just you Can Do ..... >>> NumericBox1 = EvaluateExpr(TextBox2.Text)
Private Function IsEmptyStack(ByVal AStack As Stack) As Boolean
Return (AStack.Count = 0)
End Function
Private Function IsOperator(ByVal AChar As Char) As Boolean
Return "^*/+-".Contains(AChar)
End Function
Private Function CompareOperators(ByVal Op1 As Char, ByVal Op2 As Char) As Integer
If Not (IsOperator(Op1) And IsOperator(Op2)) Then
Err.Raise(vbObjectError + 1001, "CompareOperators", "Operator(s) not suppoerted")
End If
Select Case Op1
Case "^"c
If Op2 = "^"c Then
Return 0
Else
Return 1
End If
Case "*"c, "/"c
Select Case Op2
Case "^"c
Return -1
Case "*"c, "/"c
Return 0
Case "+"c, "-"c
Return 1
End Select
Case "+"c, "-"c
Select Case Op2
Case "^"c, "*"c, "/"c
Return -1
Case "+"c, "-"c
Return 0
End Select
End Select
End Function
Private Function InfixToPostfix(ByVal InfixExpression As String) As String
Dim Infix As String
Dim Postfix As String
Dim InfixIndex As Integer
Dim InfixLen As Integer
Dim AChar As Char
Dim APeek As String
Dim ANumber As String
Dim MathStack As New Stack
Infix = InfixExpression.Trim()
If Infix = "" Then
Return ""
End If
Infix = Infix & ")"
ANumber = ""
Postfix = ""
InfixLen = Len(Infix) '- 1
InfixIndex = 0
MathStack.Clear()
MathStack.Push("(")
Do While (Not IsEmptyStack(MathStack)) And (InfixIndex <= InfixLen)
'AChar = Mid$(Infix, InfixIndex, 1)
AChar = Infix(InfixIndex)
If Char.IsDigit(AChar) Then
ANumber = ANumber & AChar
ElseIf AChar = "(" Then
If ANumber <> "" Then
Postfix = Postfix & ANumber & " "
ANumber = ""
End If
MathStack.Push(AChar)
ElseIf IsOperator(AChar) Then
If ANumber <> "" Then
Postfix = Postfix & ANumber & " "
ANumber = ""
End If
APeek = MathStack.Peek
If IsOperator(APeek) Then
Do While CompareOperators(APeek, AChar) >= 0
APeek = MathStack.Pop
Postfix = Postfix & APeek
APeek = MathStack.Peek
If Not IsOperator(APeek) Then Exit Do
Loop
End If
MathStack.Push(AChar)
ElseIf AChar = ")" Then
If ANumber <> "" Then
Postfix = Postfix & ANumber & " "
ANumber = ""
End If
APeek = MathStack.Peek
Do While APeek <> "("
APeek = MathStack.Pop
Postfix = Postfix & APeek
APeek = MathStack.Peek
Loop
MathStack.Pop()
End If
InfixIndex = InfixIndex + 1
Loop
If Not IsEmptyStack(MathStack) Then
Err.Raise(vbObjectError + 1002, "InfixToPostfix", "Invalid infix expression")
Else
InfixToPostfix = Postfix
End If
End Function
Private Function PerformOperation(ByVal Number1 As Double, ByVal Number2 As Double, ByVal AOperator As Char) As Double
Select Case AOperator
Case "+"c
Return Number1 + Number2
Case "-"c
Return Number1 - Number2
Case "*"c
Return Number1 * Number2
Case "/"c
If Number2 = 0 Then
Err.Raise(vbObjectError + 1004, "EvaluatePostfix", "Division by zero")
Else
Return Number1 / Number2
End If
Case "^"c
Return Number1 ^ Number2
Case Else
Err.Raise(vbObjectError + 1001, "CompareOperators", "Operator not suppoerted")
End Select
End Function
Private Function EvaluatePostfix(ByVal PostfixExpression As String) As Double
Dim Postfix As String
Dim ANumber As String
Dim AChar As Char
Dim PostfixIndex As Long
Dim PostfixLen As Long
Dim Num1 As Double
Dim Num2 As Double
Dim NumResult As Double
Dim MathStack As New Stack
Postfix = Trim$(PostfixExpression)
If Postfix = "" Then
Return 0.0
End If
Postfix = Postfix & "="
ANumber = ""
PostfixLen = Len(Postfix)
PostfixIndex = 0
MathStack.Clear()
Do While PostfixIndex <= PostfixLen
AChar = Postfix(PostfixIndex)
If AChar = " " Then
If ANumber <> "" Then
MathStack.Push(CDbl(ANumber))
ANumber = ""
End If
ElseIf Char.IsDigit(AChar) Then
ANumber = ANumber & AChar
ElseIf AChar = "=" Then
If ANumber <> "" Then
MathStack.Push(CDbl(ANumber))
ANumber = ""
End If
If MathStack.Count = 1 Then
Return MathStack.Pop
Else
Err.Raise(vbObjectError + 1003, "EvaluatePostfix", "Invalid postfix expression")
End If
ElseIf IsOperator(AChar) Then
If ANumber <> "" Then
MathStack.Push(CDbl(ANumber))
ANumber = ""
End If
If IsEmptyStack(MathStack) Then
Err.Raise(vbObjectError + 1003, "EvaluatePostfix", "Invalid postfix expression")
Else
Num2 = MathStack.Pop
If IsEmptyStack(MathStack) Then
Err.Raise(vbObjectError + 1003, "EvaluatePostfix", "Invalid postfix expression")
Else
Num1 = MathStack.Pop
NumResult = PerformOperation(Num1, Num2, AChar)
MathStack.Push(NumResult)
End If
End If
End If
PostfixIndex = PostfixIndex + 1
Loop
End Function
Public Function EvaluateExpr(ByVal AExpr As String) As String
Dim PostfixExpr As String
AExpr = AExpr.Trim
If AExpr = "" Then Return ""
PostfixExpr = InfixToPostfix(AExpr)
Return EvaluatePostfix(PostfixExpr)
End Function
This shouldn't really qualify as an answer, but I thought it would be fun to re-write that big code block using more modern techniques. I've done this right in the reply window, so there are probably several errors. It's worth noting, though, how much shorter this is.
We could have even more fun, and probably perform better, by also re-writing the code to think in terms of breaking apart the string into tokens, rather than by character.
Public Module Math
'Reverse precedence order, so higher precedence has higher index
Private operators As String = "-+/*^"
Private Function CompareOperators(Op1 As Char, Op2 As Char) As Integer
Dim Op1Value As Integer = operators.IndexOf(Op1)
Dim Op2Value As Integer = operators.IndexOf(Op2)
If Op1Value = -1 Then Throw New Exception($"Unsupported operator {Op1} detected")
If Op2Value = -1 Then Throw New Excpetion($"Unsupported operator {Op2} detected")
'The \ 2 adjusts for same precedence of +- and */
Return (Op1Value \ 2).CompareTo(Op2Value \ 2)
End Function
Private Function InfixToPostfix(InfixExpression As String) As String
If String.IsNullOrWhitesapce(InfixExpression) Then Return ""
InfixExpression = InfixExpression.Trim() & ")"
Dim result As New StringBuilder()
Dim MathStack As New Stack(Of Char)()
Dim ANumber As String = ""
Dim Index As Integer = 0
MathStack.Push("("c)
While MathStack.Count > 0 AndAlso Index <= InfixExpression.Length)
Dim AChar As Char = InfixExpression(Index)
If Char.IsDigit(AChar) Then
ANumber &= ANumber & AChar
ElseIf AChar = "("c Then
If Not String.IsNullOrEmpty(ANumber) Then
result.Append(ANumber).Append(" ")
ANumber = ""
End If
MathStack.Push(AChar)
ElseIf IsOperator(AChar) Then
If Not String.IsNullOrEmpty(ANumber) Then
result.Append(ANumber).Append(" ")
ANumber = ""
End If
Dim APeek As Char = MathStack.Peek()
If IsOperator(APeek) Then
While CompareOperators(APeek, AChar) >= 0
APeek = MathStack.Pop()
result.Append(APeek)
APeek = MathStack.Peek
If Not IsOperator(APeek) Then Exit While
End While
End If
MathStack.Push(AChar)
ElseIf AChar = ")"c Then
If Not String.IsNullOrEmpty(ANumber) Then
result.Append(ANumber).Append(" ")
ANumber = ""
End If
APeek = MathStack.Peek()
While APeek <> "("c
APeek = MathStack.Pop()
result.Append(APeek)
APeek = MathStack.Peek()
End While
MathStack.Pop()
End If
Index += 1
End While
If MathStack.Count > 0 Then
Throw New Exception("Invalid infix expression: stack is not empty")
End If
Return result.ToString()
End Function
Private Function PerformOperation(Number1 As Double, Number2 As Double, AOperator As Char) As Double
Select Case AOperator
Case "+"c
Return Number1 + Number2
Case "-"c
Return Number1 - Number2
Case "*"c
Return Number1 * Number2
Case "/"c
'We could detect Number2 = 0 here, but appropriate response is throwing the same DivideByZeroException the framework will do for us anyway
Return Number1 / Number2
Case "^"c
Return Number1 ^ Number2
Case Else
Throw New Exception($"Operator {AOperator} not supported")
End Select
End Function
Private Function EvaluatePostfix(Expression As String) As Double
Dim result As Double = 0R
If String.IsNullOrWhitespace(Expression) Then Return result
Expression = Expression.Trim() & "="
Dim MathStack As New Stack(Of Double)()
Dim ANumber As String = ""
Dim Index As Integer = 0
Do While Index <= Expression.Length
AChar = Expression(Index)
If AChar = " "c Then
If Not String.IsNullOrEmpty(ANumber) Then
MathStack.Push(CDbl(ANumber))
ANumber = ""
End If
ElseIf Char.IsDigit(AChar) Then
ANumber = ANumber & AChar
ElseIf AChar = "="c Then
If Not String.IsNullOrEmpty(ANumber) Then
MathStack.Push(CDbl(ANumber))
ANumber = ""
End If
If MathStack.Count = 1 Then Return MathStack.Pop()
Throw New Exception("Invalid postfix expression")
ElseIf IsOperator(AChar) Then
If Not String.IsNullOrEmpty(ANumber) Then
MathStack.Push(CDbl(ANumber))
ANumber = ""
End If
If MathStack.Count < 2 Then
Throw New Exception("Invalid postfix expression: insufficient stack")
End If
Dim Num2 As Double = MathStack.Pop()
MathStack.Push(PerformOperation(MathStack.Pop(), Num2))
End If
Index += 1
Loop
End Function
Public Function EvaluateExpr(AExpr As String) As String
If String.IsNullOrWhitespacE(AExpr) Then Return ""
Return EvaluatePostfix(InfixToPostfix(AExpr))
End Function
End Module
Wanted to do the token option for more fun:
Public Module Math
'Reverse precedence order, so higher precedence has higher index
Private operators As String = "()-+/*^"
Private Function IsOperator(AChar As Char) As Boolean
Return operators.Contains(AChar)
End Function
Private Function CompareOperators(Op1 As Char, Op2 As Char) As Integer
Dim Op1Value As Integer = operators.IndexOf(Op1)
Dim Op2Value As Integer = operators.IndexOf(Op2)
If Op1Value = -1 Then Throw New Exception($"Unsupported operator '{Op1}' detected")
If Op2Value = -1 Then Throw New Exception($"Unsupported operator '{Op2}' detected")
'The \ 2 adjusts for same precedence of +- and */
Return (Op1Value \ 2).CompareTo(Op2Value \ 2)
End Function
Private Iterator Function Tokenize(input As String) As IEnumerable(Of String)
Dim buffer As String = ""
For Each c As Char In input
If Char.IsWhitespace(c) Then
If String.IsNullOrEmpty(buffer) Then Continue For
Yield buffer
buffer = ""
ElseIf Char.IsDigit(c) OrElse c = "."c Then
buffer &= c 'Don't worry about validating good numbers at this level. Just check the characters
ElseIf c = "-"c Then ' could be operator or negative sign
If buffer.Length > 0 Then 'was an operator
Yield buffer
buffer = ""
Yield c.ToString()
Else 'Not sure yet -- treat as digit for now
buffer &= c
End If
ElseIf operators.Contains(c) OrElse "()".Contains(c) Then
If buffer.Length > 0 Then
Yield buffer
buffer = ""
End If
Yield c.ToString()
Else
Throw New Exception($"Unexpected character '{c}' in input")
End If
Next c
If buffer.Length > 0 Then Yield buffer
End Function
Private Iterator Function InfixToPostfix(tokens As IEnumerable(Of String)) As IEnumerable(Of String)
Dim buffer As New Stack(Of String)()
Dim temp As Double
For Each token As String In tokens
If Double.TryParse(token, temp) Then
Yield token
'Need to account for "(" better
ElseIf token = "(" Then
buffer.Push(token)
ElseIf operators.Contains(token) AndAlso token <> ")" Then
If buffer.Count = 0 Then
buffer.Push(token)
ElseIf CompareOperators(token, buffer.Peek()) > 0 Then
buffer.Push(token)
Else
While CompareOperators(token, buffer.Peek()) <= 0
Dim tok As String = buffer.Pop()
If Not "()".Contains(tok) Then Yield tok
If buffer.Count = 0 Then Exit While
End While
buffer.Push(token)
End If
ElseIf token = ")" Then
Dim valid As Boolean = False
While buffer.Count > 0
Dim tok As String = buffer.Pop()
If tok = "(" Then
valid = True
Exit While
Else
Yield tok
End If
End While
If Not valid Then Throw New Exception("Unbalanced parentheses in expression (missing matching '(' character)")
Else
Throw New Exception($"Unknown token type '{token}'")
End If
Next token
While buffer.Count > 0
Dim tok As String = buffer.Pop()
If Not "()".Contains(tok) Then Yield tok
End While
End Function
Private Function PerformOperation(Number1 As Double, Number2 As Double, AOperator As Char) As Double
Select Case AOperator
Case "+"c
Return Number1 + Number2
Case "-"c
Return Number1 - Number2
Case "*"c
Return Number1 * Number2
Case "/"c
'We could detect Number2 = 0 here, but appropriate response is throwing the same DivideByZeroException the framework will do for us anyway
Return Number1 / Number2
Case "^"c
Return Number1 ^ Number2
Case Else
Throw New Exception($"Operator {AOperator} not supported")
End Select
End Function
Private Function EvaluatePostfix(tokens As IEnumerable(Of String)) As Double
Dim result As Double = 0R
Dim buffer As New Stack(Of Double)()
Dim temp As Double
For Each token As String In tokens
If Double.TryParse(token, temp) Then
buffer.Push(temp)
ElseIf buffer.Count < 2 Then
Throw New Exception("Invalid postfix expression")
Else
temp = buffer.Pop()
temp = PerformOperation(buffer.Pop(), temp, token(0))
buffer.Push(temp)
End If
Next token
If buffer.Count > 1 Then Throw New Exception("Invalid expression: extra items in the buffer")
If buffer.Count = 0 Then Throw New Exception("Invalid expression: no result")
Return buffer.Pop()
End Function
Public Function Evaluate(input As String) As Double
If String.IsNullOrWhiteSpace(input) Then Return 0R
Dim tokens = Tokenize(input)
tokens = InfixToPostfix(tokens)
Return EvaluatePostfix(tokens)
End Function
End Module

Is there a way to maintain the length of a user entered number, to prevent removal of extra 0's?

I'm creating a Diabetes management algorithm, and I'm trying to find a way for the user's entered time blocks to be maintained at 4 digits
I've been searching on google, but all I have been able to find is how to check the length of a variable, which I already know how to do.
Sub timeBlocks()
Dim file As String = "C:\Users\Connor\Documents\Visual Studio 2017\Projects\meterCodeMaybe\TIMEBLOCKS.txt"
Dim blockNum As Integer
Console.WriteLine("Please be sure to enter times as a 24 hour value, rather than 12 hour, otherwise the input will not be handled.")
Console.Write("Please enter the amount of time blocks you require for your day: ")
blockNum = Console.ReadLine()
Dim timeA(blockNum - 1) As Integer
Dim timeB(blockNum - 1) As Integer
Dim sensitivity(blockNum - 1) As Integer
Dim ratio(blockNum - 1) As Integer
For i = 0 To (blockNum - 1)
Console.WriteLine("Please enter the start time of your time block")
timeA(i) = Console.ReadLine()
Console.WriteLine("Please enter the end time of your time block")
timeB(i) = Console.ReadLine()
Console.WriteLine("Please enter the ratio for this time block (Enter the amount of carbs that go into 1 unit of insulin)")
ratio(i) = Console.ReadLine()
Console.WriteLine("Please enter the insulin sensitivity for this time block
(amount of blood glucose (mmol/L) that is reduced by 1 unit of insulin.)")
sensitivity(i) = Console.ReadLine()
FileOpen(1, file, OpenMode.Append)
PrintLine(1, Convert.ToString(timeA(i)) + "-" + Convert.ToString(timeB(i)) + " 1:" + Convert.ToString(ratio(i)) + " Insulin Sensitivity:" + Convert.ToString(sensitivity(i)) + " per mmol/L")
FileClose(1)
Next
End Sub
Basically, I want the user to be able to enter a 4 digit number for their time block, to match a 24 hr time, so if they enter 0000, it is displayed as this, however, it removes all previous 0's and sets it to just 0.
Perhaps pad the number with 4 leading 0's:
Right(String(digits, "0") & timeA(i), 4)
Or as an alternative, store the value as a string so that it can be printed out in its original form.
I have written a Function to get a 24 hours format time from user, I hope it would help:
Public Function Read24HFormatTime() As String
Dim str As String = String.Empty
While True
Dim c As Char = Console.ReadKey(True).KeyChar
If c = vbCr Then Exit While
If c = vbBack Then
If str <> "" Then
str = str.Substring(0, str.Length - 1)
Console.Write(vbBack & " " & vbBack)
End If
ElseIf str.Length < 5 Then
If Char.IsDigit(c) OrElse c = ":" Then
If str.Length = 0 Then
' allow 0, 1 or 2 only
If c = "0" OrElse c = "1" OrElse c = "2" Then
Console.Write(c)
str += c
End If
ElseIf str.Length = 1 Then
If str = "0" Then
'allow 1 to 9
If c <> ":" Then
If CInt(c.ToString) >= 1 AndAlso CInt(c.ToString) <= 9 Then
Console.Write(c)
str += c
End If
End If
ElseIf str = "1" Then
'allow 0 to 9
If c <> ":" Then
If CInt(c.ToString) >= 0 AndAlso CInt(c.ToString) <= 9 Then
Console.Write(c)
str += c
End If
End If
ElseIf str = "2" Then
'allow 0 to 4
If c <> ":" Then
If CInt(c.ToString) >= 0 AndAlso CInt(c.ToString) <= 4 Then
Console.Write(c)
str += c
End If
End If
End If
ElseIf str.Length = 2 Then
'allow ":" only
If c = ":" Then
Console.Write(c)
str += c
End If
ElseIf str.Length = 3 Then
If str = "24:" Then
'allow 0 only
If c = "0" Then
Console.Write(c)
str += c
End If
Else
'allow 0 to 5
If c <> ":" Then
If CInt(c.ToString) >= 0 AndAlso CInt(c.ToString) <= 5 Then
Console.Write(c)
str += c
End If
End If
End If
ElseIf str.Length = 4 Then
If str.Substring(0, 3) = "24:" Then
'allow 0 only
If c = "0" Then
Console.Write(c)
str += c
End If
Else
'allow 0 to 9
If c <> ":" Then
If CInt(c.ToString) >= 0 AndAlso CInt(c.ToString) <= 9 Then
Console.Write(c)
str += c
End If
End If
End If
End If
End If
End If
End While
Return str
End Function
The user can only enter time like 23:59 08:15 13:10 and he couldn't enter formats like 35:10 90:00 25:13 10:61
This is a sample code to show you how to use it:
Dim myTime = DateTime.Parse(Read24HFormatTime())
Dim name = "Emplyee"
Console.WriteLine($"{vbCrLf}Hello, {name}, at {myTime:t}")
Console.ReadKey(True)

VB.NET textbox remove last dash

How can I remove the last - added after the code has been entered.
All the - are automatically added.
Here my code :
Dim strKeyTextField As String = txtAntivirusCode.Text
Dim n As Integer = 5
Dim intlength As Integer = txtAntivirusCode.TextLength
While intlength > 4
If txtAntivirusCode.Text.Length = 5 Then
strKeyTextField = strKeyTextField.Insert(5, "-")
End If
Dim singleChar As Char
singleChar = strKeyTextField.Chars(n)
While (n + 5) < intlength
If singleChar = "-" Then
n = n + 6
If n = intlength Then
strKeyTextField = strKeyTextField.Insert(n, "-")
End If
End If
End While
intlength = intlength - 5
End While
'' Define total variable with dashes
txtAntivirusCode.Text = strKeyTextField
'sets focus at the end of the string
txtAntivirusCode.Select(txtAntivirusCode.Text.Length, 0)
Output is : XXXXX-XXXXX-XXXXX-XXXXX-XXXXX-
What I want : XXXXX-XXXXX-XXXXX-XXXXX-XXXXX
You could just remove the last char in the string like that:
txtAntivirusCode.Text = strKeyTextField.Substring(0, strKeyTextField.Length - 1)
or
txtAntivirusCode.Text = strKeyTextField.Remove(strKeyTextField.Length - 1)
or
txtAntivirusCode.Text = strKeyTextField.Trim({" "c, "-"c})
or
txtAntivirusCode.Text = strKeyTextField.TrimEnd(CChar("-"))
If there is a possibility of a space at the end of the string use .Trim() before Substring and/or Remove
The other way from removing the last "-" is to not add the last "-", for example:
Dim s = "ABCDE-FGHIJKLMNOPQRSTUVWXYZ"
Dim batchSize = 5
Dim nBatches = 5
Dim nChars = nBatches * batchSize
' take out any dashes
s = s.Replace("-", "")
' make sure there are not too many characters
If s.Length > nChars Then
s = s.Substring(0, nChars)
End If
Dim sb As New Text.StringBuilder
For i = 1 To s.Length
sb.Append(s.Chars(i - 1))
If i Mod batchSize = 0 AndAlso i <> nChars Then
sb.Append("-")
End If
Next
Console.WriteLine(sb.ToString())
Console.ReadLine()
Outputs:
ABCDE-FGHIJ-KLMNO-PQRST-UVWXY

array without any duplicate value

the code to generate no. of arrays from one is working..I'm try to make some change to it like below
Function myarray(ByVal arra1() As Integer, ByVal arran() As Integer, ByVal arrNumber As Integer) As Integer()
arran = arra1.Clone()
For i As Integer = 0 To arra1.Length - 1
If i = (arrNumber - 1) Then ' IF arrNumber is 1 then +1 to index 0, If it is 2 then +1 to index 1
arran(i) = arra1(i) + 1
'If there are two duplicate value make on of them zero at a time
For k = 0 To arran.Length - 1
For j = k + 1 To arran.Length - 1
If arran(k) = arran(j) Then
arran(k) = 0
End If
'make any value great than 11 zero
If arran(i) > 11 Then
arran(i) = 0
End If
Next
Next
Else
arran(i) = arra1(i)
End If
Next
'Print the array
For i = 0 To arran.Length - 1
Console.Write(arran(i) & " ")
Next
Console.WriteLine()
Return arran
End Function
what I really need is to decompose for example {1,4,5,5} to be {1,4,0,5} and then {1,4,5,0} the above code generate only {1,4,0,5}
I haven't tested this, but I believe the following code will do what you want. Based on your comments, I've changed the function to return all resulting arrays as an array of arrays, rather than requiring the index to change as an input and returning one array. I also ignored matches of 0, as the conditions you describe don't seem designed to handle them. Because of it's recursion, I think this approach will successfully handle input such as {3, 3, 3, 3}.
Public Function jaggedArray(ByVal inputArray() As Integer) As Integer()()
If inputArray Is Nothing Then
Return Nothing
Else
Dim resultArrays()(), i, j As Integer
Dim arrayMax As Integer = inputArray.GetUpperBound(0)
If arrayMax = 0 Then 'prevents errors later if only one number passed
ReDim resultArrays(0)
If inputArray(0) > 11 Then
resultArrays(0) = {1}
ElseIf inputArray(0) = 11 Then
resultArrays(0) = {0}
Else
resultArrays(0) = {inputArray(0) + 1}
End If
Return resultArrays
End If
For i = 0 To arrayMax
Dim tempArray() As Integer = inputArray.Clone
For j = 0 To arrayMax
If tempArray(j) > 11 Then
tempArray(j) = 0
End If
Next
If tempArray(i) = 11 Then
tempArray(i) = 0
Else
tempArray(i) += 1
End If
splitArray(resultArrays, tempArray)
Next
Return resultArrays
End If
End Function
Private Sub splitArray(ByRef arrayList()() As Integer, ByVal sourceArray() As Integer)
Dim x, y As Integer 'positions of matching numbers
If isValid(sourceArray, x, y) Then
If arrayList Is Nothing Then
ReDim arrayList(0)
Else
ReDim Preserve arrayList(arrayList.Length)
End If
arrayList(arrayList.GetUpperBound(0)) = sourceArray
Else
Dim xArray(), yArray() As Integer
xArray = sourceArray.Clone
xArray(x) = 0
splitArray(arrayList, xArray)
yArray = sourceArray.Clone
yArray(y) = 0
splitArray(arrayList, yArray)
End If
End Sub
Private Function isValid(ByRef testArray() As Integer, ByRef match1 As Integer, ByRef match2 As Integer) As Boolean
For i As Integer = 0 To testArray.GetUpperBound(0) - 1
If testArray(i) > 11 Then
testArray(i) = 0
End If
For j As Integer = i + 1 To testArray.GetUpperBound(0)
If testArray(j) > 11 Then
testArray(j) = 0
End If
If testArray(i) = testArray(j) AndAlso testArray(i) > 0 Then 'added second test to prevent infinite recursion
match1 = i
match2 = j
Return False
End If
Next
Next
match1 = -1
match2 = -1
Return True
End Function

Bitwise And with Large Numbers in VBA

I keep getting an Overflow on the bitwise and in this first function. I fixed the other overflows by converting from Long to Currency (still seems weird), but I can't get this And to work.
Any ideas? I'm just trying to convert some IP addresses to CIDRs and calculate some host numbers.
Option Explicit
Public Function ConvertMaskToCIDR(someIP As String, someMask As String)
Dim ipL As Variant
ipL = iPToNum(someIP)
Dim maskL As Variant
maskL = iPToNum(someMask)
maskL = CDec(maskL)
'Convert Mask to CIDR(1-30)
Dim oneBit As Variant
oneBit = 2147483648#
oneBit = CDec(oneBit)
Dim CIDR As Integer
CIDR = 0
Dim x As Integer
For x = 31 To 0 Step -1
If (maskL And oneBit) = oneBit Then
CIDR = CIDR + 1
Else
Exit For
End If
oneBit = oneBit / 2# 'Shift one bit to the right (>> 1)
Next
Dim answer As String
answer = numToIp(ipL And maskL) & " /" & CStr(CIDR)
End Function
Public Function NumHostsInCidr(CIDR As Integer) As Currency
Dim mask As Currency
mask = maskFromCidr(CIDR)
NumHostsInCidr = iPnumOfHosts(mask)
End Function
Private Function maskFromCidr(ByVal CIDR As Integer) As Currency
'x = 32 - CIDR
'z = (2^x)-1
'return z xor 255.255.255.255
maskFromCidr = CLng(2 ^ ((32 - CIDR)) - 1) Xor 4294967295# '255.255.255.255
End Function
Private Function iPnumOfHosts(ByVal IPmsk As Currency) As Currency 'a mask for the host portion
'255.255.255.0 XOR 255.255.255.255 = 255 so 0 to 255 is 256 hosts
iPnumOfHosts = IPmsk Xor 4294967295# '255.255.255.255 , calculate the number of hosts
End Function
Private Function numToIp(ByVal theIP As Currency) As String 'convert number back to IP
Dim IPb(3) As Byte '4 octets
Dim theBit As Integer
theBit = 31 'work MSb to LSb
Dim addr As String 'accumulator for address
Dim x As Integer
For x = 0 To 3 'four octets
Dim y As Integer
For y = 7 To 0 Step -1 '8 bits
If (theIP And CLng(2 ^ theBit)) = CLng(2 ^ theBit) Then 'if the bit is on
IPb(x) = IPb(x) + CByte(2 ^ y) 'accumulate
End If
theBit = theBit - 1
Next
addr = addr & CStr(IPb(x)) & "." 'add current octet to string
Next
numToIp = trimLast(addr, ".")
End Function
Private Function iPToNum(ByVal ip As String) As Currency
Dim IPpart As Variant
Dim IPbyte(3) As Byte
IPpart = Split(ip, ".")
Dim x As Integer
For x = 0 To 3
IPbyte(x) = CByte(IPpart(x))
Next x
iPToNum = (IPbyte(0) * (256 ^ 3)) + (IPbyte(1) * (256 ^ 2)) + (IPbyte(2) * 256#) + IPbyte(3)
End Function
Private Function trimLast(str As String, chr As String)
'****
'* Remove "chr" (if it exists) from end of "str".
'****
trimLast = str
If Right(str, 1) = chr Then trimLast = Left(str, Len(str) - 1)
End Function
Whoah,
it is definitelly interesting functionality. But I would do this in very different way. I would treat IP adress and Mask as array of four bytes. Moreover as far as I remeber (well it was some time ago) CIDR and mask can be converted to each other in very simply way (did you looked at the table?). Why don't you apply bitwise operations to each byte separatelly?
BR.
edit: ok I looked closer at the code. The reason why it is overflowing is that you can't use currency and and. I think and is internally defined as Long and can't return any bigger values. It is very common in other languages too. I remember that once I had this problem in other language (Pascal?). You can try to replace and by division. It will be slow but it can't be matter here I suppose. Other solution is, like I wrote, to treat those valueas all the time as byte arrays and perform bitwise operations on each byte.
This is an entirely mathematical approach to working with IPv4 addresses in VBA (Excel specifically).
The first three functions are serving a strictly supporting role.
Support #1:
Public Function RoundDouble(ByVal Number As Double, ByVal Places As Long) As Double
On Error GoTo Err_RoundDouble
Dim i As Long
Dim j As Long
i = 0
j = 0
While Number < -(2 ^ 14)
Number = Number + (2 ^ 14)
i = i - 1
Wend
While Number > (2 ^ 14)
Number = Number - (2 ^ 14)
i = i + 1
Wend
While Number < -(2 ^ 5)
Number = Number + (2 ^ 5)
j = j - 1
Wend
While Number > (2 ^ 5)
Number = Number - (2 ^ 5)
j = j + 1
Wend
RoundDouble = Round(Number, Places) + (i * (2 ^ 14)) + (j * (2 ^ 5))
Exit_RoundDouble:
Exit Function
Err_RoundDouble:
MsgBox Err.Description
Resume Exit_RoundDouble
End Function
Support #2:
Public Function RoundDownDouble(ByVal Number As Double, ByVal Places As Long) As Double
On Error GoTo Err_RoundDownDouble
Dim i As Double
i = RoundDouble(Number, Places)
If Number < 0 Then
If i < Number Then
RoundDownDouble = i + (10 ^ -Places)
Else
RoundDownDouble = i
End If
Else
If i > Number Then
RoundDownDouble = i - (10 ^ -Places)
Else
RoundDownDouble = i
End If
End If
Exit_RoundDownDouble:
Exit Function
Err_RoundDownDouble:
MsgBox Err.Description
Resume Exit_RoundDownDouble
End Function
Support #3
Public Function ModDouble(ByVal Number As Double, ByVal Divisor As Double) As Double
On Error GoTo Err_ModDouble
Dim rndNumber As Double
Dim rndDivisor As Double
Dim intermediate As Double
rndNumber = RoundDownDouble(Number, 0)
rndDivisor = RoundDownDouble(Divisor, 0)
intermediate = rndNumber / rndDivisor
ModDouble = (intermediate - RoundDownDouble(intermediate, 0)) * rndDivisor
Exit_ModDouble:
Exit Function
Err_ModDouble:
MsgBox Err.Description
Resume Exit_ModDouble
End Function
This first function will convert a Double back into an IP address.
Public Function NUMtoIP(ByVal Number As Double) As String
On Error GoTo Err_NUMtoIP
Dim intIPa As Double
Dim intIPb As Double
Dim intIPc As Double
Dim intIPd As Double
If Number < 0 Then Number = Number * -1
intIPa = RoundDownDouble(ModDouble(Number, (2 ^ 32)) / (2 ^ 24), 0)
intIPb = RoundDownDouble(ModDouble(Number, (2 ^ 24)) / (2 ^ 16), 0)
intIPc = RoundDownDouble(ModDouble(Number, (2 ^ 16)) / (2 ^ 8), 0)
intIPd = ModDouble(Number, (2 ^ 8))
NUMtoIP = intIPa & "." & intIPb & "." & intIPc & "." & intIPd
Exit_NUMtoIP:
Exit Function
Err_NUMtoIP:
MsgBox Err.Description
Resume Exit_NUMtoIP
End Function
This second function is strictly to convert from IPv4 dotted octet format to a Double.
Public Function IPtoNUM(ByVal IP_String As String) As Double
On Error GoTo Err_IPtoNUM
Dim intIPa As Integer
Dim intIPb As Integer
Dim intIPc As Integer
Dim intIPd As Integer
Dim DotLoc1 As Integer
Dim DotLoc2 As Integer
Dim DotLoc3 As Integer
Dim DotLoc4 As Integer
DotLoc1 = InStr(1, IP_String, ".", vbTextCompare)
DotLoc2 = InStr(DotLoc1 + 1, IP_String, ".", vbTextCompare)
DotLoc3 = InStr(DotLoc2 + 1, IP_String, ".", vbTextCompare)
DotLoc4 = InStr(DotLoc3 + 1, IP_String, ".", vbTextCompare)
If DotLoc1 > 1 And DotLoc2 > DotLoc1 + 1 And _
DotLoc3 > DotLoc2 + 1 And DotLoc4 = 0 Then
intIPa = CInt(Mid(IP_String, 1, DotLoc1))
intIPb = CInt(Mid(IP_String, DotLoc1 + 1, DotLoc2 - DotLoc1))
intIPc = CInt(Mid(IP_String, DotLoc2 + 1, DotLoc3 - DotLoc2))
intIPd = CInt(Mid(IP_String, DotLoc3 + 1, 3))
If intIPa <= 255 And intIPa >= 0 And intIPb <= 255 And intIPb >= 0 And _
intIPc <= 255 And intIPc >= 0 And intIPd <= 255 And intIPd >= 0 Then
IPtoNUM = (intIPa * (2 ^ 24)) + (intIPb * (2 ^ 16)) + _
(intIPc * (2 ^ 8)) + intIPd
Else
IPtoNUM = 0
End If
Else
IPtoNUM = 0
End If
Exit_IPtoNUM:
Exit Function
Err_IPtoNUM:
MsgBox Err.Description
Resume Exit_IPtoNUM
End Function
Next we have the conversion from an IPv4 address to it's bitmask representation (assuming that the source entry is a string containing only the dotted octet format of the subnet mask).
Public Function IPtoBitMask(ByVal strIP_Address As String) As Integer
On Error GoTo Err_IPtoBitMask
IPtoBitMask = (32 - Application.WorksheetFunction.Log((2 ^ 32 - IPtoNUM(strIP_Address)), 2))
Exit_IPtoBitMask:
Exit Function
Err_IPtoBitMask:
MsgBox Err.Description
Resume Exit_IPtoBitMask
End Function
This last one is to convert a bitmask back into dotted octet format.
Public Function BitMasktoIP(ByVal intBit_Mask As Integer) As String
On Error GoTo Err_BitMasktoIP
BitMasktoIP = NUMtoIP((2 ^ 32) - (2 ^ (32 - intBit_Mask)))
Exit_BitMasktoIP:
Exit Function
Err_BitMasktoIP:
MsgBox Err.Description
Resume Exit_BitMasktoIP
End Function
Edited to remove leftover debugging code (it's been working for me so long, that I had entirely forgotten about it).
As an aside, it is faster to perform mathematical operations on a computer than it is to work with a string.
This was my "cheating" way:
Option Explicit
Public Function ConvertMaskToCIDR(varMask As Variant) As String
Dim strCIDR As String
Dim mask As String
mask = CStr(varMask)
Select Case mask
Case "255.255.255.255":
strCIDR = "/32"
Case "255.255.255.254":
strCIDR = "/31"
Case "255.255.255.252":
strCIDR = "/30"
Case "255.255.255.248":
strCIDR = "/29"
Case "255.255.255.240":
strCIDR = "/28"
Case "255.255.255.224":
strCIDR = "/27"
Case "255.255.255.192":
strCIDR = "/26"
Case "255.255.255.128":
strCIDR = "/25"
Case "255.255.255.0":
strCIDR = "/24"
Case "255.255.254.0":
strCIDR = "/23"
Case "255.255.252.0":
strCIDR = "/22"
Case "255.255.248.0":
strCIDR = "/21"
Case "255.255.240.0":
strCIDR = "/20"
Case "255.255.224.0":
strCIDR = "/19"
Case "255.255.192.0":
strCIDR = "/18"
Case "255.255.128.0":
strCIDR = "/17"
Case "255.255.0.0":
strCIDR = "/16"
Case "255.254.0.0":
strCIDR = "/15"
Case "255.252.0.0":
strCIDR = "/14"
Case "255.248.0.0":
strCIDR = "/13"
Case "255.240.0.0":
strCIDR = "/12"
Case "255.224.0.0":
strCIDR = "/11"
Case "255.192.0.0":
strCIDR = "/10"
Case "255.128.0.0":
strCIDR = "/9"
Case "255.0.0.0":
strCIDR = "/8"
Case "254.0.0.0":
strCIDR = "/7"
Case "252.0.0.0":
strCIDR = "/6"
Case "248.0.0.0":
strCIDR = "/5"
Case "240.0.0.0":
strCIDR = "/4"
Case "224.0.0.0":
strCIDR = "/3"
Case "192.0.0.0":
strCIDR = "/2"
Case "128.0.0.0":
strCIDR = "/1"
Case "0.0.0.0":
strCIDR = "/0"
End Select
ConvertMaskToCIDR = strCIDR
End Function
Public Function NumUsableIPs(cidr As String) As Long
Dim strHosts As String
If Len(cidr) > 3 Then
'They probably passed a whole address.
Dim slashIndex As String
slashIndex = InStr(cidr, "/")
If slashIndex = 0 Then
NumUsableIPs = 1
Exit Function
End If
cidr = Right(cidr, Len(cidr) - slashIndex + 1)
End If
Select Case cidr
Case "/32":
strHosts = 1
Case "/31":
strHosts = 0
Case "/30":
strHosts = 2
Case "/29":
strHosts = 6
Case "/28":
strHosts = 14
Case "/27":
strHosts = 30
Case "/26":
strHosts = 62
Case "/25":
strHosts = 126
Case "/24":
strHosts = 254
Case "/23":
strHosts = 508
Case "/22":
strHosts = 1016
Case "/21":
strHosts = 2032
Case "/20":
strHosts = 4064
Case "/19":
strHosts = 8128
Case "/18":
strHosts = 16256
Case "/17":
strHosts = 32512
Case "/16":
strHosts = 65024
Case "/15":
strHosts = 130048
Case "/14":
strHosts = 195072
Case "/13":
strHosts = 260096
Case "/12":
strHosts = 325120
Case "/11":
strHosts = 390144
Case "/10":
strHosts = 455168
Case "/9":
strHosts = 520192
Case "/8":
strHosts = 585216
Case "/7":
strHosts = 650240
Case "/6":
strHosts = 715264
Case "/5":
strHosts = 780288
Case "/4":
strHosts = 845312
Case "/3":
strHosts = 910336
Case "/2":
strHosts = 975360
Case "/1":
strHosts = 1040384
End Select
NumUsableIPs = strHosts
End Function