'Subnet Calculator V1
'Script by MJP 2010

'Note this script only works on the original spec where hosts with all-ones or all-zeros are excluded
'ref - http://www.faqs.org/rfcs/rfc1878.html

'usage cscript VBScriptSubnetCalcV2 > output.txt

   'force script to run in cscript mode
   Set objShell = CreateObject("WScript.Shell") 
   If Instr(1, WScript.FullName, "CScript", vbTextCompare) = 0 Then
      objShell.Run "%comspec% /k cscript //nologo """ & WScript.ScriptFullName & """", 1, False
      WScript.Quit
   End If

   'create dictionary objects with subnet constants. 
   Set dNetworID = CreateObject("Scripting.Dictionary")
   dNetworID.Add "192", "64"
   dNetworID.Add "224", "32"
   dNetworID.Add "240", "16"
   dNetworID.Add "248", "8"
   dNetworID.Add "252", "4"
   dNetworID.Add "254", "2"
   dNetworID.Add "255", "1"

   Set dNoNetworks = CreateObject("Scripting.Dictionary")
   dNoNetworks.Add "192", "2"
   dNoNetworks.Add "224", "6"
   dNoNetworks.Add "240", "14"
   dNoNetworks.Add "248", "30"
   dNoNetworks.Add "252", "62"
   dNoNetworks.Add "254", "126"
   dNoNetworks.Add "255", "1"
 
   'input addresses
   wscript.echo "MJP Subnet Calc"&vbcrlf
   strIP=inputbox("Enter IP", "MJP Subnet Calc", "172.16.98.53")
   strSN=inputbox("Enter Subnet Mask", "MJP Subnet Calc", "255.255.224.0")
   aSN=split(strSN, ".") : aIP=split(strIP, ".")
   acalcBits=split(calcBits(aSN, aIP), ",")

   'output results
   wscript.echo "IP Address "&strIP &vbcrlf& "Subnet Mask "&strSN &vbcrlf& "Subnet Bits "&acalcBits(0)&vbcrlf& "NetworkID Start Range "&acalcBits(1)&vbcrlf& "Number of Subnets "&acalcBits(2)&vbcrlf& "SubnetID Address "&acalcBits(3)&vbcrlf& "subnet "&Subnet(strIP, strSN) & vbcrlf

   'output a listing of host ranges
   listhosts acalcBits(0),acalcBits(1),acalcBits(2),acalcBits(3),aIP

   wscript.quit


'-------------------------------------------------------


function calcBits(aSN, aIP)
'input - addresses as an array of octets
'output - subnet bits, NetworkID Start Range, Number of Subnets, subnetId

   i=0
   x=1
   bits=0

   'loop through octets totaling subnet bits, (i) is position after last 255 subnet octet
   do 
      Octet=aSN(i) 
    
      if Octet=255 then 
         bits=bits+8
         i=i+1
      end if

      if i=4 then
         if bits<8 then
            calcBits="err - invalid subnet mask - no 255"
            exit function
         else
            calcBits=bits
            exit function
         end if
      end if
   loop until aSN(i)<>255


   'if next octet is something like 224 or 192 etc then continue totaling bits by converting the number to binary
   if aSN(i)>0 then
 
      intDec=aSN(i)
      strTemp = ""

      Do While intDec > 0
         If intDec Mod 2 > 0 Then
            strTemp = "1" & strTemp
         Else
            strTemp = "0" & strTemp
         End If
         intDec = Int(intDec / 2)
      Loop 

      
      'count the "ones" in the string
      do
         if right(strTemp, 1)="0" then 
            strTemp=left(strTemp, len(strTemp)-1)
         else
            exit do
         end if
      loop until len(strTemp)=0

      'a valid subnet mask is all "ones" from left to right
      if Len(strTemp)-Len(Replace(strTemp,"0",""))<>0 then
         msgbox "err  - invalid subnet mask - bad Octet"
         wscript.quit
      end if

   end if


   'a bit of housekeeping - subnet mask only contains 255s and 0s (one subnet)
   if aSN(i)=0 then 
      i=i-1 
   end if   


   'build output variables
   bits=bits+len(strTemp)
   nID=dNetworID.Item(aSN(i))
   nets=dNoNetworks.Item(aSN(i))

   'housekeeping again - I could probably rationalise these - basically it sets the i pointer for accessing the ip array octets
   'but I am not going to bother because this code is based on obsolite TCP-IP definition. V2 is written completely differently.
   if aSN(i)=255 then i=i+1

   'build subnetID address from supplied ip address array
   for x=0 to i-1
      subNetID=subNetID& " " &aIP(x)  
   next 
   subNetID=trim(subNetID) 

   if aSN(i)<>0 then
      subNetID=subNetID&" "&nID
   else
      subNetID=subNetID&" "&"0"
   end if

   for x=i+1 to 3
      subNetID=subNetID & " " & "0"       
   next
   subNetID=replace(subNetID, " ", ".")

   'information returned from function - comma separated variable
   calcBits=bits&","&nID&","&nets&","&subNetID

end function


'-------------------------------------------------------


function listhosts(bits,nID,nets,subnetID,aIP)
'lists subnet ranges and hosts of target subnet
'from subnet bits, NetworkID Start Range, Number of Subnets, subnetId and original IP

   'calculate some initial variables needed below
   OctetOther = 0
   maskbitsA = bits mod 8
   maskBitsB = bits - maskbitsA
   Octet255s = maskBitsB /8
   if maskbitsA >0 then OctetOther = 1

   'build bitAdd vaiable which is used in calculating last host address 
   'if this does not equal 0 then we are dealing with an ending with 192 224 240 etc
   if maskBitsA<>0 then
      if Octet255s = 3 then
         bitAdd = nID
      elseif Octet255s = 2 then
         bitAdd = (nID*255)+nID
      elseif Octet255s = 1 then
          bitAdd = (nID*65025)+(2*(nID*255))+nID
      end if
   else   'we are dealing with a standard subnet mask like 255.255.255.0
      if Octet255s = 1 then
         bitAdd = 16777216
      elseif Octet255s = 2 then
         bitAdd = 65536
      elseif Octet255s = 3 then
          bitAdd = 256
      end if 
   end if

   'turn given IP address into a hex number
   for i= 0 to 3
      aIPTemp=hex(aIP(i))
      if len(aIPTemp)<2 then aIPTemp="0"&aIPTemp
      IPHex=IPHex & aIPTemp
   next

   
   'turn SubnetID address into a hex number
   aSubNet=split(SubNetID, ".")
   for i= 0 to 3
      aSubNetTemp=hex(aSubNet(i))
      if len(aSubNetTemp)<2 then aSubNetTemp="0"&aSubNetTemp
      SubNetHex=SubNetHex & aSubNetTemp
   next

   'loop through number of networks for the given subnet mask
   for x=1 to nets

      'calculate first and last address in hex
      subIst=hex(Clng("&H" & SubNetHex) + 1)
      subLst=hex(Clng("&H" & SubNetHex) + bitAdd - 2)

      'convert hex address format into standard IP octet format
      subIstIP=Cint("&H" & mid(subIst, 1, 2)) &"."& Cint("&H" & mid(subIst, 3, 2)) &"."& Cint("&H" & mid(subIst, 5, 2)) &"."& Cint("&H" & mid(subIst, 7, 2))
      subLstIP=Cint("&H" & mid(subLst, 1, 2)) &"."& Cint("&H" & mid(subLst, 3, 2)) &"."& Cint("&H" & mid(subLst, 5, 2)) &"."& Cint("&H" & mid(subLst, 7, 2))

      'check if given IP address falls in this subnet range of addresses
      if "&H" &IPHex=>"&H" &subIst and "&H" &IPHex<="&H" &subLst then 
         wscript.echo "Range"&x&vbtab&subIstIP&vbtab&subLstIP&" (Target Network)"
       
         IPMaskMatch=true       

         'optionally list all addresses in range. 
         answer=msgbox("List all IP addresses?",36,"MJP Subnet Calc")
         if answer = 6 then 

            iHosts=Clng(("&H" &subLst)-("&H" &subIst))+1

            SubNetHexTarget = SubNetHex

            for i=1 to iHosts
               subnetTarget=Clng("&H" & SubNetHexTarget) + 1
               SubNetHexTarget = hex(subnetTarget)

               listIP = Cint("&H" & mid(SubNetHexTarget, 1, 2)) &"."& Cint("&H" & mid(SubNetHexTarget, 3, 2)) &"."& Cint("&H" & mid(SubNetHexTarget, 5, 2)) &"."& Cint("&H" & mid(SubNetHexTarget, 7, 2))
               wscript.echo listIP

            next 
         end if

      else

         wscript.echo "Range"&x&vbtab&subIstIP&vbtab&subLstIP

      end if

      SubNetHex=hex(Clng("&H" & subLst) + 2)
      
   next

   if IPMaskMatch<>true then wscript.echo vbcrlf&"(WARNING - IP Address Does Not Match This Subnet Mask)"

end function



'-------------------------------------------------------


Function Subnet(strAddress, strMask)

   on error resume next
   lenSN = Len(Left(str2bin(strMask), InStr(str2bin(strMask), "0") - 1))
   Subnet = bin2str(Left(str2bin(strAddress), lenSN) & String(32 - lenSN, "0")) 

End Function 


'-------------------------------------------------------


Function bin2str(strBinary)
'special binary to decimal function
'input 32bit binary number
'output 4 octet ip address 

   For iPosOct = 1 To 4 
      strOctBin = Right(Left(strBinary, iPosOct * 8), 8) 
      intOctet = 0 
      intValue = 1 
      For iPosBin = 1 To Len(strOctBin) 
         If Left(Right(strOctBin, iPosBin), 1) = "1" Then 
            intOctet = intOctet + intValue 
         end if
         intValue = intValue * 2 
      Next 
      If bin2str = Empty Then 
         bin2str = CStr(intOctet) 
      Else 
         bin2str = bin2str & "." & CStr(intOctet)
      end if 
   Next 

End Function 


'-----------------------------------------------------------


Function str2bin(strAddress) 
'special decimal to binary function
'input 4 octet ip address 
'output 32bit binary number

   objAddress = Split(strAddress, ".") 
   For Each strOctet In objAddress 

      intOctet = CInt(strOctet)
      strOctBin = "" 
      For x = 1 To 8 
         If intOctet Mod 2 > 0 Then 
            strOctBin = "1" & strOctBin 
         Else 
            strOctBin = "0" & strOctBin 
         End If 
         intOctet = Int(intOctet / 2) 
      Next 
      str2bin = str2bin & strOctBin 
   Next 

End Function 


'------------------------------------------------------------ 





Function lenSubnet(strMask) 
   strMaskBin = str2bin(strMask) 
   lenSubnet = Len(Left(strMaskBin, InStr(strMaskBin, "0") - 1)) 
End Function