1 #Region "Microsoft.VisualBasic::6154efddb4011b6f310ca07b3e5806ca, Microsoft.VisualBasic.Core\ApplicationServices\Tools\Network\Tcp\IPTools\LAN.vb"
2
3     ' Author:
4     
5     '       asuka (amethyst.asuka@gcmodeller.org)
6     '       xie (genetics@smrucc.org)
7     '       xieguigang (xie.guigang@live.com)
8     
9     ' Copyright (c) 2018 GPL3 Licensed
10     
11     
12     ' GNU GENERAL PUBLIC LICENSE (GPL3)
13     
14     
15     ' This program is free software: you can redistribute it and/or modify
16     ' it under the terms of the GNU General Public License as published by
17     ' the Free Software Foundation, either version 3 of the License, or
18     ' (at your option) any later version.
19     
20     ' This program is distributed in the hope that it will be useful,
21     ' but WITHOUT ANY WARRANTY; without even the implied warranty of
22     ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23     ' GNU General Public License for more details.
24     
25     ' You should have received a copy of the GNU General Public License
26     ' along with this program. If not, see <http://www.gnu.org/licenses/>.
27
28
29
30     ' /********************************************************************************/
31
32     ' Summaries:
33
34     '     Module LANTools
35     
36     '         FunctionGetAllDevicesOnLAN, GetIPAddress, GetIpNetTable, GetMacAddress, IsMulticast
37     '         Structure MIB_IPNETROW
38     
39     
40     
41     
42     
43     
44     ' /********************************************************************************/
45
46 #End Region
47
48 Imports System.Collections.Generic
49 Imports System.Collections
50 Imports System.Runtime.InteropServices
51 Imports System.Runtime.InteropServices.Marshal
52 Imports System.Net
53 Imports System.Net.NetworkInformation
54
55 Namespace Net
56
57     ''' <summary>
58     ''' http://www.codeproject.com/Tips/358946/Retrieving-IP-and-MAC-addresses-for-a-LAN
59     ''' </summary>
60     ''' <code>
61     ''' ' Get my PC IP address
62     ''' Call Console.WriteLine("My IP : {0}", GetIPAddress())
63     ''' 
64     ''' ' Get My PC MAC address
65     ''' Call Console.WriteLine("My MAC: {0}", GetMacAddress())
66     ''' 
67     ''' ' Get all devices on network
68     ''' Dim all As Dictionary(Of IPAddress, PhysicalAddress) = GetAllDevicesOnLAN()
69     ''' For Each kvp As KeyValuePair(Of IPAddress, PhysicalAddress) In all
70     '''     Console.WriteLine("IP : {0}" &amp; vbLf &amp; " MAC {1}", kvp.Key, kvp.Value)
71     ''' Next
72     ''' </code>
73     Public Module LANTools
74
75         ''' <summary>
76         ''' MIB_IPNETROW structure returned by GetIpNetTable
77         ''' DO NOT MODIFY THIS STRUCTURE.
78         ''' </summary>
79         <StructLayout(LayoutKind.Sequential)>
80         Private Structure MIB_IPNETROW
81             <MarshalAs(UnmanagedType.U4)>
82             Public dwIndex As Integer
83             <MarshalAs(UnmanagedType.U4)>
84             Public dwPhysAddrLen As Integer
85             <MarshalAs(UnmanagedType.U1)>
86             Public mac0 As Byte
87             <MarshalAs(UnmanagedType.U1)>
88             Public mac1 As Byte
89             <MarshalAs(UnmanagedType.U1)>
90             Public mac2 As Byte
91             <MarshalAs(UnmanagedType.U1)>
92             Public mac3 As Byte
93             <MarshalAs(UnmanagedType.U1)>
94             Public mac4 As Byte
95             <MarshalAs(UnmanagedType.U1)>
96             Public mac5 As Byte
97             <MarshalAs(UnmanagedType.U1)>
98             Public mac6 As Byte
99             <MarshalAs(UnmanagedType.U1)>
100             Public mac7 As Byte
101             <MarshalAs(UnmanagedType.U4)>
102             Public dwAddr As Integer
103             <MarshalAs(UnmanagedType.U4)>
104             Public dwType As Integer
105         End Structure
106
107         ''' <summary>
108         ''' GetIpNetTable external method
109         ''' </summary>
110         ''' <param name="pIpNetTable"></param>
111         ''' <param name="pdwSize"></param>
112         ''' <param name="bOrder"></param>
113         ''' <returns></returns>
114         <DllImport("IpHlpApi.dll")>
115         Private Function GetIpNetTable(pIpNetTable As IntPtr, <MarshalAs(UnmanagedType.U4)> ByRef pdwSize As Integer, bOrder As BooleanAs <MarshalAs(UnmanagedType.U4)> Integer
116         End Function
117
118         ''' <summary>
119         ''' Error codes GetIpNetTable returns that we recognise
120         ''' </summary>
121         Const ERROR_INSUFFICIENT_BUFFER As Integer = 122
122
123         ''' <summary>
124         ''' Get the IP and MAC addresses of all known devices on the LAN
125         ''' </summary>
126         ''' <remarks>
127         ''' 1) This table is not updated often - it can take some human-scale time 
128         '''    to notice that a device has dropped off the network, or a new device
129         '''    has connected.
130         ''' 2) This discards non-local devices if they are found - these are multicast
131         '''    and can be discarded by IP address range.
132         ''' </remarks>
133         ''' <returns></returns>
134         Public Function GetAllDevicesOnLAN() As Dictionary(Of IPAddress, PhysicalAddress)
135             Dim all As New Dictionary(Of IPAddress, PhysicalAddress)()
136             ' Add this PC to the list...
137             all.Add(GetIPAddress(), GetMacAddress())
138             Dim spaceForNetTable As Integer = 0
139             Get the space needed
140             ' We do that by requesting the table, but not giving any space at all.
141             ' The return value will tell us how much we actually need.
142             GetIpNetTable(IntPtr.Zero, spaceForNetTable, False)
143             ' Allocate the space
144             ' We use a try-finally block to ensure release.
145             Dim rawTable As IntPtr = IntPtr.Zero
146             Try
147                 rawTable = AllocCoTaskMem(spaceForNetTable)
148                 Get the actual data
149                 Dim errorCode As Integer = GetIpNetTable(rawTable, spaceForNetTable, False)
150                 If errorCode <> 0 Then
151                     ' Failed for some reason - can do no more here.
152                     Throw New Exception(String.Format("Unable to retrieve network table. Error code {0}", errorCode))
153                 End If
154                 Get the rows count
155                 Dim rowsCount As Integer = ReadInt32(rawTable)
156                 Dim currentBuffer As New IntPtr(rawTable.ToInt64() + SizeOf(GetType(Int32)))
157                 ' Convert the raw table to individual entries
158                 Dim rows As MIB_IPNETROW() = New MIB_IPNETROW(rowsCount - 1) {}
159                 For index As Integer = 0 To rowsCount - 1
160                     rows(index) = CType(PtrToStructure(New IntPtr(currentBuffer.ToInt64() + (index * SizeOf(GetType(MIB_IPNETROW)))), GetType(MIB_IPNETROW)), MIB_IPNETROW)
161                 Next
162                 ' Define the dummy entries list (we can discard these)
163                 Dim virtualMAC As New PhysicalAddress(New Byte() {0, 0, 0, 0, 0, 0})
164                 Dim broadcastMAC As New PhysicalAddress(New Byte() {255, 255, 255, 255, 255, 255})
165                 For Each row As MIB_IPNETROW In rows
166                     Dim ip As New IPAddress(BitConverter.GetBytes(row.dwAddr))
167                     Dim rawMAC As Byte() = New Byte() {row.mac0, row.mac1, row.mac2, row.mac3, row.mac4, row.mac5}
168                     Dim pa As New PhysicalAddress(rawMAC)
169                     If Not pa.Equals(virtualMAC) AndAlso Not pa.Equals(broadcastMAC) AndAlso Not IsMulticast(ip) Then
170                         'Console.WriteLine("IP: {0}\t\tMAC: {1}", ip.ToString(), pa.ToString());
171                         If Not all.ContainsKey(ip) Then
172                             all.Add(ip, pa)
173                         End If
174                     End If
175                 Next
176             Finally
177                 ' Release the memory.
178                 FreeCoTaskMem(rawTable)
179             End Try
180             Return all
181         End Function
182
183         ''' <summary>
184         ''' Gets the IP address of the current PC
185         ''' </summary>
186         ''' <returns></returns>
187         Public Function GetIPAddress() As IPAddress
188             Dim strHostName As String = Dns.GetHostName()
189             Dim ipEntry As IPHostEntry = Dns.GetHostEntry(strHostName)
190             Dim addr As IPAddress() = ipEntry.AddressList
191             For Each ip As IPAddress In addr
192                 If Not ip.IsIPv6LinkLocal Then
193                     Return (ip)
194                 End If
195             Next
196             Return If(addr.Length > 0, addr(0), Nothing)
197         End Function
198
199         ''' <summary>
200         ''' Gets the MAC address of the current PC.
201         ''' </summary>
202         ''' <returns></returns>
203         Public Function GetMacAddress() As PhysicalAddress
204             For Each nic As NetworkInterface In NetworkInterface.GetAllNetworkInterfaces()
205                 Only consider Ethernet network interfaces
206                 If nic.NetworkInterfaceType = NetworkInterfaceType.Ethernet AndAlso nic.OperationalStatus = OperationalStatus.Up Then
207                     Return nic.GetPhysicalAddress()
208                 End If
209             Next
210             Return Nothing
211         End Function
212
213         ''' <summary>
214         ''' Returns true if the specified IP address is a multicast address
215         ''' </summary>
216         ''' <param name="ip"></param>
217         ''' <returns></returns>
218         Public Function IsMulticast(ip As IPAddress) As Boolean
219             Dim result As Boolean = True
220             If Not ip.IsIPv6Multicast Then
221                 Dim highIP As Byte = ip.GetAddressBytes()(0)
222                 If highIP < 224 OrElse highIP > 239 Then
223                     result = False
224                 End If
225             End If
226             Return result
227         End Function
228     End Module
229 End Namespace