440 lines
16 KiB
VB.net
440 lines
16 KiB
VB.net
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 |