Doku/Dokumentation/Classes/DHCP.vb

Imports System.Net
Imports System.Runtime.InteropServices


Public Class DHCP
    <StructLayout(LayoutKind.Sequential)>
    Public Structure DHCP_IP_ARRAY
        Dim NumElements As Int32
        Dim Elements As IntPtr
    End Structure

    <StructLayout(LayoutKind.Sequential)>
    Public Structure DHCP_CLIENT_INFO_ARRAY

        Dim NumElements As Integer
        Dim Clients As IntPtr

    End Structure

    <StructLayout(LayoutKind.Sequential)>
    Public Structure DHCP_CLIENT_INFO

        Dim ClientIpAddress As Int32
        Dim SubnetMask As Int32
        Dim ClientHardwareAddress As DHCP_BINARY_DATA

        <MarshalAs(UnmanagedType.LPWStr)>
        Dim ClientName As String

        <MarshalAs(UnmanagedType.LPWStr)>
        Dim ClientComment As String

        Dim ClientLeaseExpires As Date_Time
        Dim OwnerHost As DHCP_HOST_INFO

    End Structure

    <StructLayout(LayoutKind.Sequential)>
    Public Structure DHCP_BINARY_DATA
        Dim DataLength As Int32
        Dim Data As IntPtr
    End Structure

    <StructLayout(LayoutKind.Sequential)>
    Public Structure Date_Time

        <MarshalAs(UnmanagedType.U4)>
        Dim dwLowDateTime As UInt32

        <MarshalAs(UnmanagedType.U4)>
        Dim dwHighDateTime As UInt32

    End Structure

    <StructLayout(LayoutKind.Sequential)>
    Public Structure DHCP_HOST_INFO

        Dim IpAddress As Int32

        <MarshalAs(UnmanagedType.LPWStr)>
        Dim NetBiosName As String

        <MarshalAs(UnmanagedType.LPWStr)>
        Dim HostName As String

    End Structure

    Declare Function DhcpEnumServers Lib "dhcpsapi.dll" (TODO) As DHCP
    Declare Unicode Function DhcpEnumSubnetClients Lib "Dhcpsapi" (ByVal ServerIpAddress As String, ByVal SubnetAddress As UInteger, ByRef ResumeHandle As Integer, ByVal PreferredMaximum As Integer, ByRef ClientInfo As IntPtr, ByRef ClientsRead As Integer, ByRef ClientsTotal As Integer) As Integer


    Public Shared Client_Array As DHCP_CLIENT_INFO_ARRAY

    Public Shared Sub ListSubnetClients(DHCP_Server As String, Scope As String, ByRef DHCP_Clients() As DHCP_CLIENT_INFO)

        'Dim Client_Array As DHCP_CLIENT_INFO_ARRAY
        ' Dim DHCP_Clients() As DHCP_CLIENT_INFO

        ' Why would you use int16 for a loop counter and for a pointer offset ?

        'If My.Computer.Network.Ping(DHCP_Server) Then
        'Else
        '    MsgBox("DHCP Server nicht erreichbar")
        '    Exit Sub
        'End If

        Dim i, j As Int16


        Dim pt As IntPtr

        Dim Read_Clients, Total_Clients As Int32
        Dim Error_Code As Int32
        Dim Rem_Handle As IntPtr
        Dim Scope_I As UInteger
        Dim a, b, c, d As UInteger

        Scope_I = StringIPAddressToUInt32(Scope)
        Dim Scobe_C As UInteger
        Scobe_C = StringIPAddressToUInt32("255.255.255.255")
        StringNWAdressToUInt32(Scope, a, b, c, d)

        d = a + b + c - 1

        'Call dhcpsapi
        Error_Code = DhcpEnumSubnetClients(DHCP_Server, Scope_I, Rem_Handle, 65537, pt, Read_Clients, Total_Clients)

        Client_Array = Marshal.PtrToStructure(pt, GetType(DHCP_CLIENT_INFO_ARRAY))

        ReDim DHCP_Clients(Client_Array.NumElements - 1)

        For i = 0 To Client_Array.NumElements - 1
            pt = Marshal.ReadIntPtr(Client_Array.Clients, j)
            DHCP_Clients(i) = Marshal.PtrToStructure(pt, GetType(DHCP_CLIENT_INFO))
            pt = IntPtr.Zero
            j = j + 4
            'Form1.Label1.Text &= DHCP_Clients(i).ClientName & "  -  " & DHCP_Clients(i).ClientIpAddress & "  -  " & Scobe_C - ((DHCP_Clients(i).ClientIpAddress * -1) + d) & vbCrLf
        Next i

    End Sub



    Friend Shared Function StringIPAddressToUInt32(Address As String) As UInteger
        Dim µAddress As IPAddress = System.Net.IPAddress.Parse(Address)
        Dim µAddressBytes As Byte() = µAddress.GetAddressBytes()

        Dim µReturnValue As UInteger = CUInt(µAddressBytes(0)) << 24
        'Label1.Text &= µReturnValue & vbCrLf
        µReturnValue += CUInt(µAddressBytes(1)) << 16
        'Label1.Text &= µReturnValue & vbCrLf
        µReturnValue += CUInt(µAddressBytes(2)) << 8
        'Label1.Text &= µReturnValue & vbCrLf
        µReturnValue += CUInt(µAddressBytes(3))
        'Label1.Text &= µReturnValue & vbCrLf

        Return µReturnValue
    End Function
    Friend Shared Function StringNWAdressToUInt32(Address As String, ByRef a As UInteger, ByRef b As UInteger, ByRef c As UInteger, ByRef d As UInteger) As UInteger
        Dim µAddress As IPAddress = System.Net.IPAddress.Parse(Address)
        Dim µAddressBytes As Byte() = µAddress.GetAddressBytes()

        a = CUInt(µAddressBytes(0)) << 24
        b = CUInt(µAddressBytes(1)) << 16
        c = CUInt(µAddressBytes(2)) << 8
        d = CUInt(µAddressBytes(3))

    End Function
    Friend Shared Function StringNWAdressToNWAdressSHORT(Address As String, ByRef NWAdressShort As String) As UInteger
        'Dim NWAdressSHORT As String
        Dim µAddress As IPAddress = System.Net.IPAddress.Parse(Address)
        Dim µAddressBytes As Byte() = µAddress.GetAddressBytes()
        NWAdressSHORT = µAddressBytes(0).ToString & "." & µAddressBytes(1).ToString & "." & µAddressBytes(2).ToString & "."
        'Return NWAdressSHORT

    End Function



End Class