Desktop_BLVStudio_EN/BLV_Studio/Control/DHCP/DhcpServer.vb

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