Imports System.Net Module Module1 Dim HostName As New ArrayList Dim IPv4 As New ArrayList Dim SubnetMask As New ArrayList Dim SystemGateWay As New ArrayList Dim DNS1 As New ArrayList Dim DNS2 As New ArrayList Dim NetworkCount As Integer = 0 'Count the number of network this PC is connected to. If more than two, require for selection Dim highPossibility As Integer = 0 Dim results As New ArrayList Dim AOBFound As New ArrayList Dim threads As New ArrayList Sub Main() Console.WriteLine("Home Dynamic Local Area Network Scanning Utlities") GetAllIP() If NetworkCount > 1 Then 'Ask for which network to scan. Console.WriteLine("Multiple Network Found. Auto-selecting network " & highPossibility & "." & vbNewLine & "Selected gateway: " & SystemGateWay(highPossibility) & ".") End If pingAllIPsInSubnet(highPossibility) Console.WriteLine("IP Scanning Done.") results.Sort() Console.WriteLine("The following IPs respond to ping") FindAllAOB() Console.WriteLine("AOB System are located on these hosts: ") For k As Integer = 0 To AOBFound.Count - 1 Console.WriteLine(AOBFound.Item(k)) Next If AOBFound.Count = 1 Then Process.Start("http://" & AOBFound.Item(0)) End If Console.WriteLine("DONE") Console.Read() End Sub Public Sub FindAllAOB() threads.Clear() For k As Integer = 0 To results.Count - 1 Dim thisIP As String = results.Item(k) Dim newThread As New System.Threading.Thread(Sub() SendWebRequest(thisIP)) threads.Add(newThread) newThread.Start() Console.WriteLine("Starting AOB connection on : " & thisIP) Next Dim running As Integer = results.Count - 1 Dim lastvalue As Integer = 0 While running > 0 running = 0 For i As Integer = 0 To threads.Count - 1 If (threads.Item(i).IsAlive) Then running += 1 End If Next If running <> lastvalue Then Console.WriteLine("Still waiting " & running & " threads to end.") End If lastvalue = running Threading.Thread.Sleep(200) End While End Sub Public Sub SendWebRequest(ip) Dim req As System.Net.WebRequest Dim res As System.Net.WebResponse req = System.Net.WebRequest.Create("http://" & ip & "/AOB") Try res = req.GetResponse() Console.WriteLine("AOB System Found on " & ip) AOBFound.Add(ip) Catch e As WebException Console.WriteLine("AOB not found on ip: " & ip) End Try End Sub Public Function getMaskValue(mask) If mask = "255.255.255.0" Then Return 1 ElseIf mask = "255.255.0.0" Then Return 2 Else Return -1 'Not supported for such a large network End If End Function Public Sub pingAllIPsInSubnet(networkid As Integer) Dim ip As String = IPv4.Item(networkid) Dim mk As String = SubnetMask.Item(networkid) Dim mkv As Integer = getMaskValue(mk) If (mkv <> -1) Then If mkv = 1 Then For d As Integer = 1 To 254 Dim thisIP = ip.Substring(0, ip.LastIndexOf(".")) & "." & d.ToString Dim newThread As New System.Threading.Thread(Sub() CheckIfIpAlive(thisIP)) threads.Add(newThread) newThread.Start() Console.WriteLine("Starting thread to connect : " & thisIP) 'Threading.Thread.Sleep(200) Next Dim running As Integer = 254 Dim lastvalue As Integer = 0 While running > 0 running = 0 For i As Integer = 0 To threads.Count - 1 If (threads.Item(i).IsAlive) Then running += 1 End If Next If running <> lastvalue Then Console.WriteLine("Still waiting " & running & " threads to end.") End If lastvalue = running Threading.Thread.Sleep(200) End While ElseIf mkv = 2 Then Console.Write("Currently not supported") End If Else Console.Write("Network too big. Please set up manually.") Return End If End Sub Public Sub CheckIfIpAlive(thisip) If tryPing(thisip) = True Then results.Add(thisip) End If End Sub Private Function FillZeros(val) If val < 10 Then Return "00" & val.ToString ElseIf val < 100 Then Return "0" & val.ToString Else Return val.ToString End If End Function Public Sub GetAllIP() 'On Error Resume Next HostName.Add(System.Net.Dns.GetHostName()) For Each ip In System.Net.Dns.GetHostEntry(HostName.Item(NetworkCount)).AddressList If ip.AddressFamily = Net.Sockets.AddressFamily.InterNetwork Then 'IPv4 Adress IPv4.Add(ip.ToString()) For Each adapter As Net.NetworkInformation.NetworkInterface In Net.NetworkInformation.NetworkInterface.GetAllNetworkInterfaces() For Each unicastIPAddressInformation As Net.NetworkInformation.UnicastIPAddressInformation In adapter.GetIPProperties().UnicastAddresses If unicastIPAddressInformation.Address.AddressFamily = Net.Sockets.AddressFamily.InterNetwork Then If ip.Equals(unicastIPAddressInformation.Address) Then 'Subnet Mask SubnetMask.Add(unicastIPAddressInformation.IPv4Mask.ToString()) Dim adapterProperties As Net.NetworkInformation.IPInterfaceProperties = adapter.GetIPProperties() For Each gateway As Net.NetworkInformation.GatewayIPAddressInformation In adapterProperties.GatewayAddresses 'Default Gateway SystemGateWay.Add(gateway.Address.ToString()) Next 'DNS1 If adapterProperties.DnsAddresses.Count > 0 Then DNS1.Add(adapterProperties.DnsAddresses(0).ToString()) End If 'DNS2 If adapterProperties.DnsAddresses.Count > 1 Then DNS2.Add(adapterProperties.DnsAddresses(1).ToString()) End If End If End If Next Next Console.WriteLine("IPv4: " & IPv4.Item(NetworkCount)) Console.WriteLine("Subnet Mask: " & SubnetMask.Item(NetworkCount)) If (SystemGateWay.Count <= NetworkCount) Then SystemGateWay.Add("N/A") Else highPossibility = NetworkCount End If Console.WriteLine("Gateway: " & SystemGateWay.Item(NetworkCount)) Console.WriteLine("") NetworkCount += 1 End If Next End Sub Public Function tryPing(ip As String) On Error GoTo errorPoint If My.Computer.Network.Ping(ip) Then Return True Else errorPoint: Return False End If End Function End Module