subnetting aka firing up PB after a long break

[Baldrick]

Been a long time since I have done any coding, (As in years...) so knocked this little thing up just to help me to start remembering a bit.
Nothing special, not tips or tricks, etc, just a bit of gibberish to get me maybe going again.
If it is useful to anybody, that’s great, else "oh well"
(Also, I am still on an older version of PB at the moment as I have just not gotten around to updating.)

Code: Select all

#Title="Subnet Calculator"
Enumeration 
#window_0
#ip_address_host
#ip_netmask
#String_bin_host
#string_bin_netmask
#string_network_number
#string_bin_network_number
#string_broadcast_address
#string_bin_broadcast_address
#String_cidr
#string_otherinfo
#Button1
EndEnumeration

host.q
netmask.q
networkaddress.q
broadcast.q
cidr.l

Procedure CheckCharactersValid(Text$,gadget)
  For a=1 To Len(text$)
    ch$=Mid(text$,a,1)
    ch=Asc(ch$)
    If ch<46 Or ch>57 Or ch=47
      msg.s="Invalid character in "
      Select gadget
        Case #ip_address_host
          msg$=msg+"Host Ip Address"
        Case #ip_netmask
          msg$=msg+"Netmask Address"
      EndSelect
      MessageRequester("Error",msg$)
      ProcedureReturn 0
    EndIf 
  Next
  ProcedureReturn 1
EndProcedure

Procedure CheckDDNValid(Text$,gadget)
  dots=CountString(Text$,".")
  If dots <>3
    msg.s="Inavlid dotted Decimal Notation - "
    Select gadget
      Case #ip_address_host
        msg$=msg+"Host IP Address"
      Case #ip_netmask
        msg$=msg+"Netmask Address"
    EndSelect
    MessageRequester("Error",msg$)
    ProcedureReturn 0
  EndIf 
  ProcedureReturn 1
EndProcedure 

Procedure CheckValidNetmask(mask.q)
  If FindString(Bin(mask),"01")
    MessageRequester("error", "Invalid netmask used")
    ProcedureReturn 0
  EndIf
  ProcedureReturn 1
EndProcedure

Procedure.q ParseAddress(Text$,gadget.l)
  If Not  CheckCharactersValid(Text$,gadget) Or Not CheckDDNValid(Text$,gadget)
    ProcedureReturn 0
  EndIf
  qty=CountString(Text$,".")
  For a=1 To qty+1
    If Val(StringField(Text$,a,"."))>255
      msg.s= " octet "+Str(a)+" - "+StringField(Text$,a,".")+" - Invalid value"
      Select gadget
          Case #ip_netmask
            msg$="inavlid netmask @"+msg
          Case #ip_address_host
            msg$="invalid host address @"+msg
        EndSelect
        MessageRequester("Error",msg$)
      ProcedureReturn 0
    EndIf
    ntext$+RSet(Bin(Val(StringField(Text$,a,"."))),8,"0")
  Next
  ProcedureReturn Val("%"+ntext$)
EndProcedure

Procedure.q BitwiseAnd(bwaddress.q,bwnetmask.q)
  ProcedureReturn bwaddress & bwnetmask
EndProcedure

Procedure.s NetworkAddressString(naaddress.q)
  b=3 : address$=""
  While b>-1
     ips=IPAddressField(naaddress,b)
     address$+Str(ips)
      If b
       address$+"."
      EndIf 
     b-1
  Wend
  ProcedureReturn address$
EndProcedure

Procedure.q BroadcastAddress(netaddress.q,mask.q)
  mask$=RSet(Bin(mask),32,"0")
  hostlength=CountString(mask$,"0")
  netlength=CountString(mask$,"1")
  t$=LSet(t$,hostlength,"1")
  netadd$=RSet(Bin(netaddress),32,"0")
  net2$=RemoveString(netadd$,"0",#PB_String_NoCase,netlength); seems to be a little bug in removestring??
  If Len(net2$)<netlength ;workaround seems to be a bug in removestring??
    net2$+"0"
  EndIf ; comment this section out to see bug in action...
  net2$+t$
  ProcedureReturn Val("%"+net2$)
EndProcedure 

Procedure Counthosts(broadcastaddress.q,networkaddress.q) 
  ProcedureReturn broadcastaddress-(networkaddress+1)
EndProcedure

Procedure Countsubnets(acidr)
  a=acidr%8
  ProcedureReturn Pow(2,a)
EndProcedure

Procedure DisplayInfo(netaddress.q,hostaddress.q,netbits.q,maskaddress.q,broadcastaddress.q,errorlevel.l,hosts.l,subnets.l)
  If Not errorlevel
    SetGadgetText(#String_bin_host,RSet(Bin(hostaddress),32,"0"))
    SetGadgetText(#String_bin_netmask,RSet(Bin(maskaddress),32,"0"))
    SetGadgetText(#String_cidr,"/"+Str(netbits))
    SetGadgetText(#String_network_number,NetworkAddressString(netaddress))
    SetGadgetText(#string_bin_network_number,RSet(Bin(netaddress),32,"0"))
    SetGadgetText(#String_broadcast_address,NetworkAddressString(broadcastaddress))
    SetGadgetText(#string_bin_broadcast_address,RSet(Bin(broadcastaddress),32,"0"))
    SetGadgetText(#string_otherinfo,"Useable hosts per Sub/Network = "+Str(hosts)+", Possible Sub/Networks = "+Str(subnets))
    tip$="Network Address = "+GetGadgetText(#string_network_number)
    tip$+" | Useable Hosts  = "+Str(hosts)
    tip$+" | Sub/Networks = "+Str(subnets)
    GadgetToolTip(#string_otherinfo,tip$)
  Else
    msg.s="invalid, please check your addressing"
    SetGadgetText(#String_bin_host,"")
    SetGadgetText(#String_bin_netmask,"")
    SetGadgetText(#String_cidr,"")
    SetGadgetText(#String_network_number,"")
    SetGadgetText(#string_bin_network_number,"")
    SetGadgetText(#String_broadcast_address,"")
    SetGadgetText(#string_bin_broadcast_address,"")
    SetGadgetText(#string_otherinfo,msg)
  EndIf 
EndProcedure

Procedure win1()
  result=OpenWindow(#window_0,0,0,550,275,#Title,#PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_MinimizeGadget)
  If result 
    Delay(50)
    StringGadget(#ip_address_host,15,25,120,30,"192.168.3.55")
    GadgetToolTip(#ip_address_host,"Host IP Address")
    TextGadget(#String_bin_host,140,25,260,30,"",#PB_Text_Border)
    StringGadget(#ip_netmask,15,60,120,30,"255.255.255.0")
    GadgetToolTip(#ip_netmask,"Netmask (Valid octets - 0,128,192,224,240,248,252,254,255)")
    TextGadget(#String_bin_netmask,140,60,260,30,"",#PB_Text_Border)
    TextGadget(#String_cidr,410,60,50,30,"",#PB_Text_Border)
    GadgetToolTip(#String_cidr,"Classless InterDomain Routing number")
    StringGadget(#string_network_number,15,100,120,30,"")
    GadgetToolTip(#string_network_number,"Network Address")
    StringGadget(#string_broadcast_address,15,140,120,30,"")
    GadgetToolTip(#string_broadcast_address,"Broadcast Address")
    TextGadget(#string_bin_network_number,140,100,260,30,"",#PB_Text_Border)
    TextGadget(#string_bin_broadcast_address,140,140,260,30,"",#PB_Text_Border)
    StringGadget(#string_otherinfo,15,180,500,30,"")
    GadgetToolTip(#string_otherinfo,"Some geekish info...")
    ButtonGadget(#Button1,230,220,100,40,"Calculate")
  EndIf 
  ProcedureReturn result
EndProcedure

If Not win1()
  MessageRequester("Fail","Window opening fault")
  End
EndIf

Repeat
  ev=WaitWindowEvent(1)
  Select ev
    Case #PB_Event_Gadget 
      Select EventGadget()
        Case #Button1
          Host=Parseaddress(GetGadgetText(#ip_address_host),#ip_address_host)
          netmask=ParseAddress(GetGadgetText(#ip_netmask),#ip_netmask)
          maskvalid=CheckValidNetmask(netmask)
          cidr=CountString(Bin(netmask),"1")
          networkaddress=BitwiseAnd(host,netmask)
          broadcast=BroadcastAddress(networkaddress,netmask)
          If maskvalid And host And netmask
            errors=0
            nbrhosts=Counthosts(broadcast,networkaddress)
            nbrsubnets=CountSubnets(cidr)
          Else 
            errors=1
          EndIf 
          DisplayInfo(networkaddress,host,cidr,netmask,broadcast,errors,nbrhosts,nbrsubnets)
      EndSelect
    Case #PB_Event_CloseWindow 
      Quit=#True 
  EndSelect
  
Until quit

[GoodNPlenty]

Very useful, Thank You for sharing

[netmaestro]

not sure the version you're using but your implementation of remove string looks wrong.

[Baldrick]

not sure the version you're using but your implementation of remove string looks wrong.

Most probably is, being it is soooo long since I have done anything with PB at all...
Still on 5.22 on Linux & I think the same on windows.

I will have a bit of a play around with the removesrting when I am looking for something to do.

[TI-994A]

...so knocked this little thing up just to help me to start remembering a bit.

Code: Select all

net2$=RemoveString(netadd$,"0",#PB_String_NoCase,netlength); seems to be a little bug in removestring??

Poor little thing got knocked-up by the big, bad Baldrick.

Anyway, the RemoveString() function requires all the parameters if the last one is to be used. So, your implementation should include the start position, before indicating the number of occurrences to remove, like so:

Code: Select all

net2$ = RemoveString(netadd$, "0", #PB_String_NoCase, 1, netlength)

However, if your intent is to remove all the occurrences, as it appears to be, simply omit the last two parameters altogether. Moreover, since you seem to be removing a number string (numbers are case irrelevant), even the mode parameter could be omitted as well.

So, this should do:

Code: Select all

net2$ = RemoveString(netadd$, "0")

Just some thoughts.

[Baldrick]

Thanks huys, I have actually picked up on what it was. I missed a parameter, so by changing:

Code: Select all

net2$=RemoveString(netadd$,"0",#PB_String_NoCase,netlength)

to

Code: Select all

net2$=RemoveString(netadd$,"0",#PB_String_NoCase,netlength,hostlength)

all fixed.
still seems odd to me though as the missed parameter is optional & being that it was set to start 2/3 the way through the string, I still don't really know why it was dropping a '0' when the first octet was a number below 127 - i.e. 01111111
e.g. 192.168.1.1 works fine, 130.168.1.1 was good, but 10.168.1.1 would go all wrong..
But no matter coz it works ok now & serves the purpose I wrote it for quite well I think.

...so knocked this little thing up just to help me to start remembering a bit.

Code: Select all

net2$=RemoveString(netadd$,"0",#PB_String_NoCase,netlength); seems to be a little bug in removestring??

Poor little thing got knocked-up by the big, bad Baldrick.

Hmm, did a little bit of "embedding", and some "source" injection, all done in the "French" way of course... Next thing you know a "Baldrick v2" pops up which is just what the world needed. So simple you might just say it was just PureBasic!!

[Michael Vogel]

Nice re-start, Baldrick!

Just one remark, subnetting can be done from any starting point, one possibility is to take the classful network mask - you could easily change your code to do so...

Code: Select all

Enumeration
	:
	#ip_default_mask;   add one additional gadget
	:
EndEnumeration

Procedure win1()
	:
	TextGadget(#ip_default_mask,410,25,50,30,"-",#PB_Text_Border)
	:
EndProcedure

Just one procedure has to be changed and some few lines added in the main part of your program...

Code: Select all

Procedure Countsubnets(acidr,defaultmask=24)
	
	ProcedureReturn 1<<(acidr-defaultmask)
	
EndProcedure

If maskvalid And host And netmask
	defaultmask=FindString(RSet(Bin(Parseaddress(GetGadgetText(#ip_address_host),#ip_address_host)),32,"0"),"0")<<3
	SetGadgetText(#ip_default_mask,"/"+Str(defaultmask))
	nbrhosts=Counthosts(broadcast,networkaddress)
	nbrsubnets=CountSubnets(cidr,defaultmask)
	errors=0
Else
	errors=1
EndIf

[Baldrick]

Thanks michael,
I will look at doing that.
Your little sample codes are actually quite similar to my way using the bit shifting, etc & when I get back up to speed I might redo in that format as I just like that way much better personally. I was planning on doing it this way, but it is just incredible how much I have not so much forgotten, but have a hard time remembering after such a long time away from any coding at all.
My real purpose for writing this little thing was for a couple of guys I work with, 1 who knows absolutely nothing about networks at all & the other has a bad tendency to try this "lets open up the network range on our host computer" by setting the netmask deliberately to 255.0.0.0 regardless of what has been set. (Looking for such things as IpCameras new & existing on networks.) I have had a bit of a hard time trying to explain to him why this method just does not work, so decided to show him with all 32 binary bits on display so he can maybe get the idea of what is actually happening with all these numbers.

Just happens that this little program is actually quite handy for working out a subnet.

[Michael Vogel]

Hi Baldrick,
I am quite sure your program is doing a fine job - well done.

I want to give you another suggestion, what could make the binary output more readable.
Just add the following procedure...

Code: Select all

Procedure.s BinaryText(ip)
	Protected s.s
	s=RSet(Bin(ip&$FFFFFFFF),32,"0")
	ProcedureReturn Left(s,8)+" "+Mid(s,9,8)+" "+Mid(s,17,8)+" "+Mid(s,25,8)
EndProcedure

...and change the lines where the text gadgets are set, for example:

Code: Select all

SetGadgetText(#String_bin_netmask,RSet(Bin(maskaddress),32,"0"));	old code
SetGadgetText(#String_bin_netmask,BinaryText(maskaddress));				new code

[Baldrick]

Excellent suggestion Michael.
I have ended up using a "." to make it a sort of Dotted Binary Notation which matches the ddn & it really does make it easier to read for these guys. nice pick up!
I will update the code in the 1st post once I have tested on windows.

[Baldrick]

hi again Michael,
Took me a little bit to work out why you had the anding in your procedure "&FFFFFFFF", then it dawned on me it was because your were passing the value into it as a standard PB signed long 32 bit where the Bin function takes & returns as a quad, so feeding a long with a negative sign in it makes it go 1's all the way out to 64 bits.
changing the passed in value to a quad eliminates the need for the anding. ( I was using quads due to the signing nature of longs in PB which makes it hard to explain to a non programming person how that stuff works & why those big numbers look negative.
anyway:

Code: Select all

Procedure.s BinaryText(ip.q)
  Protected s.s
  ;s=RSet(Bin(ip&$FFFFFFFF),32,"0")
  s=RSet(Bin(ip),32,"0")
   ProcedureReturn Left(s,8)+"."+Mid(s,9,8)+"."+Mid(s,17,8)+"."+Mid(s,25,8)
EndProcedure

A little offtopic now.
Then when looking at the PB help file I noticed something a little odd in the bin function:
from the help file for the bin() function for optional types:

#PB_Long : The value is handled as a long number, ranging from 0 to 4294967296
Which to me is what I would class as a 32 bit unsigned long!

But from the general help file regards variables, types, etc:

Long | .l | 4 bytes | -2147483648 to +2147483647
Which to me is what I would class as a 32 bit signed long!

So I guess in a sort of a way, PB does after all have an unsigned long type....