‘==================================================
‘ 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
'==================================================
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