Imports System.Management Imports System.Net Imports System.Net.NetworkInformation Imports System.Net.Sockets Imports System.Text Imports ARSoft.Tools.Net.Dns Imports DotNetProjects.DhcpServer Imports DotNetProjects.DhcpServer.DHCPRequest Public Class DhcpServer Public Event OupPrintfDHCPlog(IPadd As String, mac As String, msgtype As Integer) Public Event IsOpenwifi(Iswifi As Boolean) Enum IPStateType NotAllocated = 1 ' 未分配 Assigned ' 待分配 TakeUp ' 占用 Overdue ' 过期 End Enum Public test As DotNetProjects.DhcpServer.DHCPServer Public _IndexIPDic As Dictionary(Of String, dhcpInfo) Sub New(Optional IPPoolMax As Integer = 10) _IndexIPDic = New Dictionary(Of String, dhcpInfo) sendReply = New DHCPReplyOptions iscnt = False isnumber = 0 'GetMACAddress() init(IPPoolMax) End Sub Public Sub init(Optional IPPoolMax As Integer = 10) Dim isNetworkInterfaces As NetworkInterface() = System.Net.NetworkInformation.NetworkInterface.GetAllNetworkInterfaces() Dim ipProperties As IPInterfaceProperties Dim gateways As UnicastIPAddressInformationCollection Dim loadip As IPAddress = IPAddress.Parse("192.168.1.10") Dim mac As String = String.Empty For Each inten In isNetworkInterfaces If inten.NetworkInterfaceType = NetworkInterfaceType.Ethernet Then 'SetIPAddress({192, 168, 1, 10}, {255, 255, 255, 0}, {192, 168, 1, 1}, {8, 8, 8, 8}, inten) 'SetManagementBaseObject(inten) ipProperties = inten.GetIPProperties gateways = ipProperties.UnicastAddresses For Each tmp In gateways If tmp.Address.AddressFamily = AddressFamily.InterNetwork Then 'loadip = tmp.Address mac = inten.GetPhysicalAddress.ToString End If Next test = New DotNetProjects.DhcpServer.DHCPServer(loadip) test.SendDhcpAnswerNetworkInterface = inten test.BroadcastAddress = IPAddress.Parse("255.255.255.255") SetsendReply(loadip.ToString) InitIPPool(loadip.ToString, IPPoolMax, mac) Try DHCPRuning() Catch ex As Exception 'MsgBox($"{loadip.ToString }_{inten.Name }{ex}") init(IPPoolMax) End Try Exit For End If Next End Sub Public Function GetMACAddress() As String Dim mac As String = String.Empty For Each nic In NetworkInterface.GetAllNetworkInterfaces Console.WriteLine(nic.GetPhysicalAddress.ToString) Next End Function Public Sub DHCPRuning() 'InitIPPool(inten.GetIPProperties, IPPoolMax) AddHandler test.OnDataReceived, AddressOf UserDHCPDataReceivedEventHandler AddHandler test.OnDiscover, AddressOf UserDHCPDataReceivedEventHandler AddHandler test.OnRequest, AddressOf UserDHCPDataReceivedEventHandler AddHandler test.OnDecline, AddressOf UserDHCPDataReceivedEventHandler AddHandler test.OnReleased, AddressOf UserDHCPDataReceivedEventHandler AddHandler test.OnInform, AddressOf UserDHCPDataReceivedEventHandler test.Start() End Sub Public Sub SetsendReply(txt_LoadIP As String) sendReply.SubnetMask = IPAddress.Parse("255.255.0.0") sendReply.ServerIpAddress = IPAddress.Parse(txt_LoadIP) '本机电脑iP sendReply.IPAddressLeaseTime = 86400 sendReply.RenewalTimeValue_T1 = 86400 sendReply.RebindingTimeValue_T2 = 86400 sendReply.DomainName = "demo.pi" sendReply.ServerIdentifier = IPAddress.Parse(txt_LoadIP) '本机电脑iP sendReply.RouterIP = IPAddress.Parse("192.168.1.1") sendReply.DomainNameServers = GetDomainNameServers("8.8.8.8,8.4.4.4") 'sendReply.LogServerIP = IPAddress.Parse(options_120.Text) IPfile = "/pxelinux.0" End Sub Public Function GetDomainNameServers(theip As String) As IPAddress() Dim ipstr2() As String = theip.Split(",") Dim result As New List(Of IPAddress) For Each index2 In ipstr2 result.Add(IPAddress.Parse(index2)) Next Return result.ToArray End Function Public Function SetManagementBaseObject(isNetworkInterfaces As NetworkInterface) As ManagementBaseObject Dim mos As ManagementObjectSearcher = New ManagementObjectSearcher("select * from Win32_NetworkAdapterConfiguration") For Each mo As ManagementObject In mos.Get() If mo("Description").ToString().Equals(isNetworkInterfaces.Description) Then Dim newIP As ManagementBaseObject = mo.GetMethodParameters("EnableStatic") Dim newGateway As ManagementBaseObject = mo.GetMethodParameters("SetGateways") Dim newDNS As ManagementBaseObject = mo.GetMethodParameters("SetDNSServerSearchOrder") newIP.Item("IPAddress") = New String() {192, 168, 1, 10} newIP.Item("SubnetMask") = New String() {255, 255, 255, 0} newGateway.Item("DefaultIPGateway") = New String() {192, 168, 1, 1} ' newDNS.Item("DNSServerSearchOrder") = New String[] { info.DNS }; Dim setIP As ManagementBaseObject = mo.InvokeMethod("EnableStatic", newIP, Nothing) Dim setGateways As ManagementBaseObject = mo.InvokeMethod("SetGateways", newGateway, Nothing) Dim setDNS As ManagementBaseObject = mo.InvokeMethod("SetDNSServerSearchOrder", newDNS, Nothing) 'mo.InvokeMethod("SetDNSServerSearchOrder", Nothing); '//DNS的地址清 ' mo.InvokeMethod("EnableDHCP", Nothing) '//开启DHCP End If Next End Function Public Shared Sub SetIPAddress(ByVal ip As String(), ByVal submask As String(), ByVal getway As String(), ByVal dns As String(), isNetworkInterfaces As NetworkInterface) Dim wmi As ManagementClass = New ManagementClass("Win32_NetworkAdapterConfiguration") Dim moc As ManagementObjectCollection = wmi.GetInstances() Dim inPar As ManagementBaseObject = Nothing Dim outPar As ManagementBaseObject = Nothing For Each mo As ManagementObject In moc '/如果没有启用IP设置的网络设备则跳过 Console.WriteLine($"{mo("Description").ToString()}") If Not mo("Description").ToString().Equals(isNetworkInterfaces.Description) Then Continue For ' 设置IP地址和掩码 If ip IsNot Nothing AndAlso submask IsNot Nothing Then inPar = mo.GetMethodParameters("EnableStatic") inPar("IPAddress") = ip inPar("SubnetMask") = submask outPar = mo.InvokeMethod("EnableStatic", inPar, Nothing) End If ' //设置网关地址 If getway IsNot Nothing Then inPar = mo.GetMethodParameters("SetGateways") inPar("DefaultIPGateway") = getway outPar = mo.InvokeMethod("SetGateways", inPar, Nothing) End If ' //设置DNS地址 If dns IsNot Nothing Then inPar = mo.GetMethodParameters("SetDNSServerSearchOrder") inPar("DNSServerSearchOrder") = dns outPar = mo.InvokeMethod("SetDNSServerSearchOrder", inPar, Nothing) End If Next End Sub Public Sub ClockDHCPServer() If IsNothing(test) Then Return test.BroadcastAddress = IPAddress.Parse("0.0.0.0") test.Dispose() ' test.BroadcastAddress = IPAddress.Parse("0.0.0.0") End Sub Public Sub UserDHCPDataReceivedEventHandler(dhcpRequest As DHCPRequest) AnalytischeGegevens(dhcpRequest) ' dhcpRequest.SendDHCPReply(,,) End Sub Public iscnt As Boolean Public isnumber As Integer Public Sub AnalytischeGegevens(dhcpRequest As DHCPRequest) Select Case dhcpRequest.GetMsgType Case DHCPMsgType.DHCPACK Case DHCPMsgType.DHCPDECLINE Case DHCPMsgType.DHCPDISCOVER '上线 'Dim ipinfo As NetworkInterface = test.SendDhcpAnswerNetworkInterface 'If iscnt Then ' RaiseEvent IsOpenwifi(False) ' iscnt = False 'End If Dhcp_OFFER(dhcpRequest) Case DHCPMsgType.DHCPINFORM Case DHCPMsgType.DHCPNAK Case DHCPMsgType.DHCPOFFER Case DHCPMsgType.DHCPRELEASE '下线 Case DHCPMsgType.DHCPREQUEST Dhcp_ACK(dhcpRequest) End Select End Sub Public Function GetByteIPToString(buff() As Byte) As String Dim result As String = "" For Each index In buff result = result & index & "." Next result = result.Substring(0, result.Length - 1) Return result End Function Public Sub InitIPPool(startIP As String, ipMax As Integer, mac As String) Dim ipstrbuff() As String Dim number As Integer = 0 ipstrbuff = startIP.Split(".") Dim cip As String = "" Dim ClientIP(3) As Byte _IndexIPDic.Clear() For i = 0 To 3 Integer.TryParse(ipstrbuff(i), number) ClientIP(i) = number If i < 3 Then cip = cip & ClientIP(i) & "." End If Next If Not _IndexIPDic.ContainsKey(startIP) Then Dim newinfo As New dhcpInfo(ClientIP) newinfo.ChildState = IPStateType.Assigned newinfo.ChildMac = GetMacStr(mac) _IndexIPDic.Add(startIP, newinfo) End If For i As Integer = 1 To ipMax If ClientIP(3) + i > 255 Then Return Dim nClientIP(3) As Byte Array.Copy(ClientIP, nClientIP, ClientIP.Length) nClientIP(3) = ClientIP(3) + i If _IndexIPDic.ContainsKey(cip & nClientIP(3).ToString) Then Continue For _IndexIPDic.Add(cip & nClientIP(3).ToString, New dhcpInfo(nClientIP)) Next End Sub Public sendReply As DHCPReplyOptions Public IPfile As String Public Sub Dhcp_ACK(dhcpRequest As DHCPRequest) Dim sda As DHCPPacket = dhcpRequest.GetRawPacket Dim RequestedIP As IPAddress = dhcpRequest.GetRequestedIP Dim cmac As String = GetMacStr(sda.chaddr) Dim newinfo As dhcpInfo = CheckIsTakeUp(RequestedIP.ToString, cmac) Try If IsNothing(newinfo) Then dhcpRequest.SendDHCPReply(DHCPMsgType.DHCPNAK, IPAddress.Any, sendReply) RaiseEvent OupPrintfDHCPlog(RequestedIP.ToString, cmac, 4) Return End If Catch ex As Exception Return End Try Dim IPstr As String = GetByteIPToString(newinfo.ChilIP) Dim ip As IPAddress = IPAddress.Parse(IPstr) sda.op = &H2 sda.htype = &H1 sda.hlen = &H6 sda.hops = &H0 sda.flags = {&H0, &H1} sda.giaddr = {&H0, &H0, &H0, &H0} sda.yiaddr = newinfo.ChilIP sda.siaddr = newinfo.ChilIP Dim filebuff() As Byte = Encoding.UTF8.GetBytes(IPfile) Array.Copy(filebuff, sda.file, filebuff.Length) Try RaiseEvent OupPrintfDHCPlog(IPstr, cmac, 5) dhcpRequest.SendDHCPReply(DHCPMsgType.DHCPACK, ip, sendReply) Catch ex As Exception Console.WriteLine("发送异常:" & ex.ToString) End Try End Sub Public Sub Dhcp_OFFER(dhcpRequest As DHCPRequest) Dim sda As DHCPPacket = dhcpRequest.GetRawPacket Dim cmac As String = GetMacStr(sda.chaddr) RaiseEvent OupPrintfDHCPlog("", cmac, 1) Dim newinfo As dhcpInfo = GetNewIPInfo(cmac) Dim dic As New Dictionary(Of DHCPOption, Byte()) dic.Add(DHCPOption.NetBIOSoverTCPIPNameServer, {8, 8, 8, 8}) dic.Add(DHCPOption.NetworkTimeProtocolServers, {&H58, &HBF, &HE4, &H8A}) dic.Add(DHCPOption.TFTPServerName, {&H31, &H39, &H32, &H2E, &H31, &H36, &H38, &H2E, &H31, &H2E, &H31, &H30}) dic.Add(DHCPOption.DomainName, {&H64, &H65, &H6D, &H6F, &H2E, &H70, &H69}) dic.Add(DHCPOption.StaticRoutes, {&H78, &H30, &H42, &H41, &H43, &H31, &H30, &H43, &H30, &H41, &H38, &H30, &H31, &H46, &H45}) sendReply.OtherRequestedOptions = dic If IsNothing(newinfo) Then dhcpRequest.SendDHCPReply(DHCPMsgType.DHCPNAK, IPAddress.Any, sendReply) RaiseEvent OupPrintfDHCPlog("", cmac, 2) Return End If 'Dim IPstr As String = GetByteIPToString(newinfo.ChilIP) 'Dim ip As IPAddress = IPAddress.Parse(IPstr) Dim IPstr As String = GetByteIPToString(newinfo.ChilIP) Dim ip As IPAddress = IPAddress.Parse(IPstr) newinfo.ChildMac = cmac newinfo.ChildState = IPStateType.Assigned sda.op = &H2 sda.htype = &H1 sda.hlen = &H6 sda.hops = &H0 sda.flags = {&H0, &H1} sda.giaddr = {&H0, &H0, &H0, &H0} sda.yiaddr = newinfo.ChilIP sda.siaddr = newinfo.ChilIP Dim filebuff() As Byte = Encoding.UTF8.GetBytes(IPfile) Array.Copy(filebuff, sda.file, filebuff.Length) Try dhcpRequest.SendDHCPReply(DHCPMsgType.DHCPOFFER, ip, sendReply, dic) RaiseEvent OupPrintfDHCPlog(IPstr, cmac, 3) Catch ex As Exception Console.WriteLine("发送异常:" & ex.ToString) End Try End Sub Public Function GetMacStr(duff As String) As String Dim sresult As String = "" For i As Integer = 0 To 5 sresult = sresult & duff.Substring(i * 2, 2) & ":" Next Return sresult.Substring(0, sresult.Length - 1) End Function Public Function GetMacStr(duff() As Byte) As String Dim sresult As String = "" Dim locadMac(5) As Byte Array.Copy(duff, locadMac, locadMac.Length) For Each index In locadMac sresult = sresult & Hex(index) & ":" Next Return sresult.Substring(0, sresult.Length - 1) End Function Public Function GetNewIPInfo(mac As String) As dhcpInfo Dim newdhcpInfo As dhcpInfo Dim olddhcpInfo As dhcpInfo For Each index In _IndexIPDic.Values If mac.Equals(index.ChildMac) Then Return index If IsNothing(newdhcpInfo) AndAlso index.ChildState = IPStateType.NotAllocated Then newdhcpInfo = index Exit For End If If IsNothing(olddhcpInfo) AndAlso index.ChildState = IPStateType.Overdue Then olddhcpInfo = index End If Next If Not IsNothing(newdhcpInfo) Then Return newdhcpInfo ElseIf Not IsNothing(olddhcpInfo) Then Return olddhcpInfo Else Return Nothing End If End Function Public Function CheckIsTakeUp(name As String, mac As String) As dhcpInfo If _IndexIPDic.ContainsKey(name) Then Dim Index = _IndexIPDic.Item(name) 'ip 被占用 且用户 Mac 地址一致 If Index.ChildState <> IPStateType.NotAllocated AndAlso Index.ChildMac.Equals(mac) Then Index.ChildState = IPStateType.Assigned Return Index Else Return Nothing End If End If Return Nothing End Function End Class Public Class dhcpInfo Public ChilIP() As Byte Public ChildMac As String = "" Public ChildTime As Long = 0 Public ChildState As Integer = 1 Sub New(ip() As Byte) ChilIP = ip ChildMac = "" ChildTime = 0 ChildState = 1 End Sub End Class