The Pigstye

Tom Willett's Playground

Here you will find my collected notes, code and musings.

• Home
• Computer Forensics >>
• Notes
• PowerShell Scripts
• Remediation
• Documentation
• SysAdmin
• Code

Subnetting Functions to use in Excel

'============================================================================================
' Module: SubNetFunctions
' Author: Tom Willett
' Date: 9/6/2010
' Description:  This is a collection of subneting functions using cidr subnetting in VBA.
' 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.
' 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 in represented as a long (actually double) returns the ip in dotted format
'=============================================================================================
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 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(ByVal 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 &lf;= 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

This Website made with hand crafted html and css.

Everything here is released under the No License.