VBA CIDR Subnetting Functions

For a project I was working on I needed a set of functions that would understand CIDR subnetting. This was on an Access Database and it needed to be very portable or I would have created a dll to do it. Access VBA has a serious limitation for this project, there is no unsigned long. To get around this limitation I converted all the decimal equivalents of ip to doubles and used the ascii representation of the binary to do the necessary masking operations. Here it is, hope it saves someone else the time of having to recreate this work.

‘==================================================
‘ Module: SubNetFunctions
‘ Author: Tom Willett
‘ Date: 9/6/2010
‘ License: GPL
‘ Description: This is a collection of subneting functions using cidr subnetting.
‘ The subnet functions are a cludge because vba does not have an unsigned long.
‘ All of the functions therefore, use the ascii representation of the binary numbers to do
‘ their calculations and store the decimal equivalent of the ip as a double.
‘ The functions available are:
‘ broadcastIP — given a subnet in cidr format returns the broadcastIP in dotted format
‘ cidr2mask — given a cidr returns the equivalent mask
‘ highestIP — given a subnet in cidr format returns the highest usable address in dotted format
‘ lowestIP — given a subnet in cidr format returns the first usable address in dotted format
‘ subnetID — given a subnet in cidr format returns the subnet id in dotted format
‘ —— helper functions ———-
‘ AbinAnd — binary ands two 8bit ascii binary numbers and returns the ascii binary result
‘ Bin2Dec — given a binary number as a string returns the decimal equivalent as a string
‘ Dec2Bin — given a decimal number as a string returns the binary equivalent as a string
‘ ip2long — given an ip in dotted format returns the long equivalent (actually double)
‘ long2ip — given a ip represented as a long (actually double) returns the ip in dotted format
‘
‘ All of these functions have been tested on 64 and 32 bit versions of Access 2010 and 2007
‘=============================================================================================
Option Compare Database
Option Explicit

‘======================================================
‘ Bin2Dec
‘
‘ Parameter BinNum — binary number as a string
‘ Return Decimal equivalent as a string
‘======================================================
Public Function Bin2Dec(ByVal BinNum As String) As String
Dim i As Integer
Dim DecNum As Long

On Error GoTo ErrorHandler

‘ Loop thru BinString
For i = Len(BinNum) To 1 Step -1
‘ Check the string for invalid characters
If Asc(Mid(BinNum, i, 1)) < 48 Or _
Asc(Mid(BinNum, i, 1)) > 49 Then
DecNum = “”
Err.Raise 1002, “BinToDec”, “Invalid Input”
End If
‘ If bit is 1 then raise 2^LoopCount and add it to DecNum
If Mid(BinNum, i, 1) And 1 Then
DecNum = DecNum + 2 ^ (Len(BinNum) – i)
End If
Next i
‘ Return DecNum as a String
Bin2Dec = CStr(DecNum)
ErrorHandler:
End Function

‘==============================================================
‘ Dec2Bin
‘
‘ Parameter DecNum — decimal number as a string
‘ Return — Binary equivalent of DecNum as a string
‘===============================================================
Public Function Dec2Bin(ByVal DecNum As String) As String
Dim BinNum As String
Dim lDecNum As Long
Dim i As Integer

On Error GoTo ErrorHandler

‘ Check the string for invalid characters
For i = 1 To Len(DecNum)
If Asc(Mid(DecNum, i, 1)) < 48 Or _
Asc(Mid(DecNum, i, 1)) > 57 Then
BinNum = “”
Err.Raise 1010, “DecToBin”, “Invalid Input”
End If
Next i

i = 0
lDecNum = Val(DecNum)

Do
If lDecNum And 2 ^ i Then
BinNum = “1″ & BinNum
Else
BinNum = “0″ & BinNum
End If
i = i + 1
Loop Until 2 ^ i > lDecNum
‘ Return BinNum as a String
Dec2Bin = BinNum
ErrorHandler:
End Function

‘===============================================
‘ AbinAnd
‘
‘ Parameters Bin1 and Bin2 are 8 bit binary numbers represented as strings
‘ Return A binary number as a string which is the result of doing a binary AND of Bin1 and Bin2
‘===============================================
Public Function AbinAnd(ByVal bin1 As String, ByVal bin2 As String) As String
‘ This function takes two binary numbers as strings and returns the string representration of the two anded together
Dim x As Byte
Dim nBin As String

nBin = String(8, “0″)
bin1 = Right(nBin & bin1, 8 )
bin2 = Right(nBin & bin2, 8 )
For x = 1 To 8
If Mid(bin1, x, 1) = “1″ And Mid(bin2, x, 1) = “1″ Then
Mid(nBin, x, 1) = “1″
End If
Next
AbinAnd = nBin
End Function

‘===========================================================
‘ cidr2mask
‘
‘ Parameter — cidr as a string — decimal from 1 to 31
‘ Return the mask equivalent of the cidr in dotted format
‘===========================================================

Public Function cidr2mask(cidr As String) As String
‘converts the cidr bits to the subnet mask
Dim BuildBin As String
Dim octet(3) As String
Dim x, y As Byte
Dim cCtr As Byte

cCtr = CByte(cidr)
For x = 0 To 3
BuildBin = “”
For y = 1 To 8
If cCtr > 0 Then
BuildBin = BuildBin & “1″
Else
BuildBin = BuildBin & “0″
End If
If cCtr > 0 Then
cCtr = cCtr – 1
End If
Next
octet(x) = Bin2Dec(BuildBin)
Next

cidr2mask = Join(octet, “.”)
End Function

‘====================================================
‘ subnetID
‘
‘Given a subnet address in cidr format return the subnetID in dotted format
‘====================================================
Public Function subnetID(subnet As String) As String
Dim BuildBin As String
Dim Parts As Variant
Dim octet As Variant
Dim Mask(3) As String
Dim x, y As Byte
Dim cCtr As Byte

‘split address and cidr
On Error Resume Next
Parts = Split(subnet, “/”)
octet = Split(Parts(0), “.”)
cCtr = CByte(Parts(1))
‘load mask octets
For x = 0 To 3
BuildBin = “”
For y = 1 To 8
If cCtr > 0 Then
BuildBin = BuildBin & “1″
Else
BuildBin = BuildBin & “0″
End If
If cCtr > 0 Then
cCtr = cCtr – 1
End If
Next
Mask(x) = BuildBin
Next
‘convert ip octets to binary string
For x = 0 To 3
octet(x) = Dec2Bin(octet(x))
Next

‘AND Binary Expressions.

For x = 0 To 3
octet(x) = Bin2Dec(AbinAnd(Mask(x), octet(x)))
Next

subnetID = Join(octet, “.”)
End Function

‘=======================================================
‘ broadcaseIP
‘
‘given a subnet in cidr format return the broadcast address in dotted format
‘=======================================================
Public Function broadcastIP(subnet As String) As String
Dim BuildBin As String
Dim Parts As Variant
Dim octet As Variant
Dim Mask(3) As String
Dim IPBin As String
Dim x, y As Byte
Dim cCtr As Byte

‘split address and cidr
On Error Resume Next
Parts = Split(subnet, “/”)
octet = Split(Parts(0), “.”)
cCtr = CByte(Parts(1))
‘convert ip octets to binary string
For x = 0 To 3
octet(x) = Right(“00000000″ & Dec2Bin(octet(x)), 8 )
Next

‘Create Full IP as Binary
IPBin = Join(octet, “”)

BuildBin = “”
For x = 1 To 32
If x < = cCtr Then
BuildBin = BuildBin & Mid(IPBin, x, 1)
Else
BuildBin = BuildBin & "1"
End If
Next

Mask(0) = Bin2Dec(Mid(BuildBin, 1, 8 ))
Mask(1) = Bin2Dec(Mid(BuildBin, 9, 8 ))
Mask(2) = Bin2Dec(Mid(BuildBin, 17, 8 ))
Mask(3) = Bin2Dec(Mid(BuildBin, 25, 8 ))
broadcastIP = Join(Mask, ".")
End Function

'==================================================
' lowestIP
'
' Parameter subnet in cidr format as a string
' Return the lowest usable ip in a cidr range
'==================================================

Public Function lowestIP(subnet As String) As String
Dim BuildBin As String
Dim Parts As Variant
Dim octet As Variant
Dim Mask(3) As String
Dim x, y As Byte
Dim cCtr As Byte

'split address and cidr
Parts = Split(subnet, "/")
octet = Split(Parts(0), ".")
cCtr = CByte(Parts(1))
'load mask octets
For x = 0 To 3
BuildBin = ""
For y = 1 To 8
If cCtr > 0 Then
BuildBin = BuildBin & “1″
Else
BuildBin = BuildBin & “0″
End If
If cCtr > 0 Then
cCtr = cCtr – 1
End If
Next
Mask(x) = BuildBin
Next
‘convert ip octets to binary string
For x = 0 To 3
octet(x) = Dec2Bin(octet(x))
Next

‘AND Binary Expressions.
‘convert octets to masked octets
For x = 0 To 3
octet(x) = Bin2Dec(AbinAnd(Mask(x), octet(x)))
Next

BuildBin = Right(“00000000″ & Dec2Bin(octet(3)), 8 )
Mid(BuildBin, 8, 1) = “1″
octet(3) = Bin2Dec(BuildBin)

lowestIP = Join(octet, “.”)

End Function

‘==============================================================
‘ highestIP
‘
‘ Parameter subnet in cidr format as a string
‘ Return highest usable IP for given cidr
‘==============================================================
Public Function highestIP(subnet As String) As String
Dim BuildBin As String
Dim Parts As Variant
Dim octet As Variant
Dim Mask(3) As String
Dim IPBin As String
Dim x, y As Byte
Dim cCtr As Byte

‘split address and cidr
Parts = Split(subnet, “/”)
octet = Split(Parts(0), “.”)
cCtr = CByte(Parts(1))
‘load mask octets
For x = 0 To 3
BuildBin = “”
For y = 1 To 8
If cCtr > 0 Then
BuildBin = BuildBin & “1″
Else
BuildBin = BuildBin & “0″
End If
If cCtr > 0 Then
cCtr = cCtr – 1
End If
Next
Mask(x) = BuildBin
Next
‘convert ip octets to binary string
For x = 0 To 3
octet(x) = Dec2Bin(octet(x))
Next

‘AND Binary Expressions.
‘convert octets to masked octets
For x = 0 To 3
octet(x) = Right(“00000000″ & AbinAnd(Mask(x), octet(x)), 8 )
Next

IPBin = Join(octet, “”)
BuildBin = “”

cCtr = CByte(Parts(1))
For x = 1 To 32
If x < = cCtr Then
BuildBin = BuildBin & Mid(IPBin, x, 1)
Else
If x = 32 Then
BuildBin = BuildBin & "0"
Else
BuildBin = BuildBin & "1"
End If
End If
Next

Mask(0) = Bin2Dec(Mid(BuildBin, 1, 8 ))
Mask(1) = Bin2Dec(Mid(BuildBin, 9, 8 ))
Mask(2) = Bin2Dec(Mid(BuildBin, 17, 8 ))
Mask(3) = Bin2Dec(Mid(BuildBin, 25, 8 ))

highestIP = Join(Mask, ".")
End Function

'==================================================
' IP2Long
'
' Parameter -- IP in dotted format as a string
' Return - decimal equivalent as a double
' VBA does not have an unsigned long Image may be NSFW.
Clik here to view.
'==================================================
Public Function IP2Long(ByVal IP As String) As Double
Dim IPLong As Double
Dim IPpart As Variant
Dim IPbyte(4) As Double
'IPpart(0).IPpart(1).IPpart(2).IPpart(3)

IPpart = Split(IP, ".")
Dim x As Byte
For x = 0 To 3
IPbyte(x) = CByte(IPpart(x))
Next
IPLong = ((IPbyte(0) * (256 ^ 3)) + (IPbyte(1) * (256 ^ 2)) + (IPbyte(2) * 256) + IPbyte(3))

IP2Long = IPLong
End Function

'=====================================================
' Long2IP
'
' Parameter Decimal value of the IP as a double
' Return dotted representation of the IP as a string
'=====================================================

Public Function Long2IP(ByVal LongIP As Double) As String
Dim ByteIP(4) As String
Dim x As Byte
Dim IP As String

If LongIP < 4294967296# And LongIP >= 0 Then
ByteIP(0) = Fix(LongIP / (256 ^ 3))
ByteIP(1) = Fix(((LongIP – (ByteIP(0) * (256 ^ 3))) / (256 ^ 2)))
ByteIP(2) = Fix(((LongIP – (ByteIP(0) * (256 ^ 3)) – (ByteIP(1) * (256 ^ 2))) / 256))
ByteIP(3) = ((LongIP – (ByteIP(0) * (256 ^ 3)) – (ByteIP(1) * (256 ^ 2)) – (ByteIP(2) * 256)))
IP = ByteIP(0) & “.” & ByteIP(1) & “.” & ByteIP(2) & “.” & ByteIP(3)
Long2IP = IP
Else
Long2IP = -1
End If
End Function