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