Enumerating Windows Native DHCP Server with VB.NET

Imports System.Runtime.InteropServices
Public Class Form1
    'http://social.msdn.microsoft.com/Forums/en-US/512c7fc3-fb32-4081-a8c2-451883abe9fb/dhcpclientinfovq-bclienttype
    Declare Unicode Function DhcpEnumSubnetClients Lib "dhcpsapi" (ByVal ServerIpAddress As String, ByVal SubnetAddress As UInt32, ByRef ResumeHandle As IntPtr, ByVal PreferredMaximum As Integer, ByRef ClientInfo As IntPtr, ByRef ClientsRead As Integer, ByRef ClientsTotal As Integer) As Integer
    &lt;DllImport("dhcpsapi.dll", SetLastError:=True, CharSet:=CharSet.Unicode)&gt; _
    Public Shared Function DhcpSetClientInfo( _
        ByVal ServerIpAddress As String, _
        ByVal ClientInfo As IntPtr) As UInt32
    End Function
    &lt;DllImport("dhcpsapi.dll", SetLastError:=True, CharSet:=CharSet.Unicode)&gt; _
    Public Shared Function DhcpSetClientInfoV4( _
        ByVal ServerIpAddress As String, _
        ByVal ClientInfoV4 As IntPtr) As UInt32
    End Function
    &lt;DllImport("dhcpsapi.dll", SetLastError:=True, CharSet:=CharSet.Unicode)&gt; _
    Public Shared Function DhcpGetClientInfo( _
        ByVal ServerIpAddress As String, _
        ByRef SearchInfo As DHCP_SEARCH_INFO, _
        ByRef ClientInfo As IntPtr) As UInt32
    End Function
    &lt;DllImport("dhcpsapi.dll", SetLastError:=True, CharSet:=CharSet.Unicode)&gt; _
    Public Shared Function DhcpSetClientInfoVQ( _
        ByVal ServerIpAddress As String, _
        ByVal ClientInfo As IntPtr) As UInt32
    End Function
    &lt;StructLayout(LayoutKind.Sequential)&gt; _
    Private Structure DHCP_IP_ARRAY
        Dim NumElements As Int32
        Dim Elements As IntPtr
    End Structure
    &lt;StructLayout(LayoutKind.Sequential)&gt; _
    Private Structure DHCP_CLIENT_INFO_ARRAY
        Dim NumElements As Integer
        Dim Clients As IntPtr
    End Structure
    &lt;StructLayout(LayoutKind.Sequential)&gt; _
    Private Structure DHCP_CLIENT_INFO
        Dim ClientIpAddress As UInt32
        Dim SubnetMask As UInt32
        Dim ClientHardwareAddress As DHCP_BINARY_DATA
        &lt;MarshalAs(UnmanagedType.LPWStr)&gt; Dim ClientName As String
        &lt;MarshalAs(UnmanagedType.LPWStr)&gt; Dim ClientComment As String
        Dim ClientLeaseExpires As MyDate_Time
        Dim OwnerHost As DHCP_HOST_INFO
    End Structure
    &lt;StructLayout(LayoutKind.Sequential)&gt; _
    Private Structure DHCP_CLIENT_INFOV4
        Dim ClientIpAddress As UInt32
        Dim SubnetMask As UInt32
        Dim ClientHardwareAddress As DHCP_BINARY_DATA
        &lt;MarshalAs(UnmanagedType.LPWStr)&gt; Dim ClientName As String
        &lt;MarshalAs(UnmanagedType.LPWStr)&gt; Dim ClientComment As String
        Dim ClientLeaseExpires As MyDate_Time
        Dim OwnerHost As DHCP_HOST_INFO
        Dim bClientType As DHCP_CLIENT_TYPE
    End Structure
    &lt;StructLayout(LayoutKind.Sequential)&gt; _
    Public Structure DHCP_CLIENT_INFO_ARRAY_VQ
        Dim NumElements As Integer
        Dim Clients As IntPtr
    End Structure
    &lt;StructLayout(LayoutKind.Sequential)&gt; _
    Private Structure DHCP_CLIENT_INFO_VQ
        Dim ClientIpAddress As UInt32
        Dim SubnetMask As UInt32
        Dim ClientHardwareAddress As DHCP_BINARY_DATA
        &lt;MarshalAs(UnmanagedType.LPWStr)&gt; Dim ClientName As String
        &lt;MarshalAs(UnmanagedType.LPWStr)&gt; Dim ClientComment As String
        Dim ClientLeaseExpires As MyDate_Time
        Dim OwnerHost As DHCP_HOST_INFO
        Dim bClientType As DHCP_CLIENT_TYPE
        Dim AddressState As Byte
        Dim Status As DHCP_QuarantineStatus
        Dim ProbationEnds As MyDate_Time
        Dim QuarantineCapable As Boolean
    End Structure
    Enum DHCP_CLIENT_TYPE As Byte
        CLIENT_TYPE_DHCP = 1
        CLIENT_TYPE_BOOTP = 2
        CLIENT_TYPE_BOTH = 3
        CLIENT_TYPE_RESERVATION_FLAG = 4
        CLIENT_TYPE_NONE = &amp;H64
    End Enum
    Enum DHCP_AddressState As Byte
        CLIENT_TYPE_DHCP = 1
        CLIENT_TYPE_BOOTP = 2
        CLIENT_TYPE_BOTH = 3
        CLIENT_TYPE_RESERVATION_FLAG = 4
        CLIENT_TYPE_NONE = &amp;H64
    End Enum
    Enum DHCP_QuarantineStatus As Byte
        NOQUARANTINE = 0
        RESTRICTEDACCESS = 1
        DROPPACKET = 2
        PROBATION = 3
        EXEMPT = 4
        DEFAULTQUARSETTING = 5
        NOQUARINFO = 6
    End Enum
    &lt;StructLayout(LayoutKind.Sequential)&gt; _
    Structure DHCP_DATE_TIME
        Dim dwLowDateTime As Integer
        Dim dwHighDateTime As Integer
    End Structure
    &lt;StructLayout(LayoutKind.Sequential)&gt; _
    Structure DHCP_BINARY_DATA
        Dim DataLength As Int32
        Dim Data As IntPtr
    End Structure
    &lt;StructLayout(LayoutKind.Sequential)&gt; _
    Private Structure MyDate_Time
        &lt;MarshalAs(UnmanagedType.U4)&gt; _
        Dim dwLowDateTime As UInt32
        &lt;MarshalAs(UnmanagedType.U4)&gt; _
        Dim dwHighDateTime As UInt32
        Public Function ConvertIntToDateTime() As DateTime
            If dwHighDateTime = 0 And dwLowDateTime = 0 Then Return DateTime.MinValue
            If dwHighDateTime = Int32.MaxValue And dwLowDateTime = UInt32.MaxValue Then Return DateTime.MaxValue
            Dim value As Long = dwHighDateTime
            value &lt;&lt;= 32
            value += dwLowDateTime
            Return DateTime.FromFileTime(value)
        End Function
        Public Sub SetToReserved()
            dwLowDateTime = 0
            dwHighDateTime = 0
            'Return DateTime.FromFileTime(value)
        End Sub
        Public Sub SetToInfinte()
            dwLowDateTime = 4294967295
            dwHighDateTime = 2147483647
            'Return DateTime.FromFileTime(value)
        End Sub
    End Structure
    &lt;StructLayout(LayoutKind.Sequential)&gt; _
    Structure DHCP_HOST_INFO
        Dim IpAddress As Int32
        &lt;MarshalAs(UnmanagedType.LPWStr)&gt; _
        Dim NetBiosName As String
        &lt;MarshalAs(UnmanagedType.LPWStr)&gt; _
        Dim HostName As String
    End Structure
    ''' &lt;summary&gt;
    ''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ''' DHCP SERVER STRUCTS
    ''' &lt;/summary&gt;
    ''' &lt;remarks&gt;&lt;/remarks&gt;
    &lt;StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)&gt; _
    Public Structure DHCPDS_SERVER
        Dim Version As UInt32
        Dim ServerName As String
        Dim ServerAddress As UInt32
        Dim Flags As UInt32
        Dim State As UInt32
        Dim DsLocation As String
        Dim DsLocType As UInt32
    End Structure
    &lt;StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)&gt; _
    Public Structure DHCPDS_SERVERS
        Dim Flags As UInt32
        Dim NumElements As UInt32
        Dim Servers As IntPtr
    End Structure
    Declare Unicode Function DhcpEnumServers Lib "Dhcpsapi.dll" (ByVal Flags As UInt32, _
      ByVal IdInfo As IntPtr, _
      ByRef Servers As IntPtr, _
      ByVal CallbackFn As IntPtr, _
      ByVal CallbackData As IntPtr) As UInt32
    ''' &lt;summary&gt;
    ''' Sumery
    ''' &lt;/summary&gt;
    ''' &lt;returns&gt;&lt;/returns&gt;
    ''' &lt;remarks&gt;&lt;/remarks&gt;
    '''
    &lt;StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)&gt; _
    Public Structure DHCP_IP_ADDRESS
        Dim IPAddress As UInteger
    End Structure
    ''' &lt;summary&gt;
    ''' Sumery
    ''' &lt;/summary&gt;
    ''' &lt;returns&gt;&lt;/returns&gt;
    ''' &lt;remarks&gt;&lt;/remarks&gt;
    '''
    &lt;StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)&gt; Public Structure DHCP_SUBNET_INFO
        Public SubnetAddress As UInteger
        Public SubnetMask As UInteger
        Public SubnetName As String
        Public SubnetComment As String
        'Public PrimaryHost As DHCP_HOST_INFO
        Public SubnetState As DHCP_SUBNET_STATE
    End Structure
    Public Enum DHCP_SUBNET_STATE
        DhcpSubnetEnabled = 0
        DhcpSubnetDisabled = 1
        DhcpSubnetEnabledSwitched = 2
        DhcpSubnetDisabledSwitched = 3
        DhcpSubnetInvalidState = 4
    End Enum
    Public Declare Unicode Function DhcpGetSubnetInfo Lib "Dhcpsapi" (ByVal ServerIpAddress As String, ByVal SubnetAddress As Integer, ByRef SubnetInfo As DHCP_SUBNET_INFO) As Integer
    Public Declare Unicode Function DhcpEnumSubnets Lib "Dhcpsapi" (ByVal ServerIpAddress As String, ByRef ResumeHandle As Integer, ByVal PreferredMaximum As Integer, ByRef EnumInfo As IntPtr, ByRef ElementsRead As Integer, ByRef ElementsTotal As Integer) As Integer
    Dim HowManyClients As Long = 0
    Dim HowManyClientsAreAlreadyReserved As Long = 0
    Dim HowManyClientsAreNeedToBechanged As Long = 0
    Dim HowManyClientsHaveBadAddresses As Long = 0
    Dim MachinesThatWillChange As String = vbNullString
    Dim MachinesThatWillNotChange As String = vbNullString
    Dim ServerIPAddress As String = "10.10.10.10"
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim ts = Stopwatch.StartNew
        ' Your code goes here
        EnumAll()
        Debug.WriteLine("How many clients: " &amp; HowManyClients)
        Debug.WriteLine("How many clients are already reserved: " &amp; HowManyClientsAreAlreadyReserved)
        Debug.WriteLine("How many clients need to be changed: " &amp; (HowManyClientsAreNeedToBechanged - HowManyClientsHaveBadAddresses))
        Debug.WriteLine("How many clients have bad addresses: " &amp; HowManyClientsHaveBadAddresses)
        Debug.WriteLine("-----------------------------------------------------------------------")
        Debug.WriteLine("Machines that will change")
        Debug.WriteLine(MachinesThatWillChange)
        Debug.WriteLine("-----------------------------------------------------------------------")
        Debug.WriteLine("Machines that will NOT change")
        Debug.WriteLine(MachinesThatWillNotChange)
        ' Format and display the TimeSpan value.
        Dim myelapsedTime As String = String.Format("{0:00}:{1:00}:{2:00}.{3:00}", ts.Elapsed.Hours, ts.Elapsed.Minutes, ts.Elapsed.Seconds, ts.Elapsed.Milliseconds / 10)
        Debug.WriteLine("RunTime " &amp; myelapsedTime)
        'EnumServers()
        'GetSubnets("10.10.10.10")
        'ListSubnetClients("10.10.10.10", "10.10.10.100")
        'CompareFirewallRules()
        'GetClientInfo("10.10.10.10", "10.10.10.100")
    End Sub
    Public Function GetSubnets(ByVal ServerIp As String) As String()
        Dim StringsToReturn() As String
        Dim ServerIpAddress = ServerIp
        Dim DHCPResult As UInt32 = 0
        Dim IPS As IntPtr
        Dim nr As UInteger = 0
        Dim Total As UInteger = 0
        Dim resumehandle As UInteger = 0
        DHCPResult = DhcpEnumSubnets(ServerIpAddress, resumehandle, 1000, IPS, nr, Total)
        If DHCPResult = 0 Then
            Dim iparray As DHCP_IP_ARRAY = CType(Marshal.PtrToStructure(IPS, GetType(DHCP_IP_ARRAY)), DHCP_IP_ARRAY)
            Dim Size As Integer = iparray.NumElements
            Dim outArray As IntPtr = iparray.Elements
            Dim ipAddressesArray(Size) As DHCP_IP_ADDRESS
            Array.Resize(StringsToReturn, Size + 1)
            Dim current As IntPtr = outArray
            For i = 0 To Size
                ipAddressesArray(i) = New DHCP_IP_ADDRESS
                ipAddressesArray(i) = CType(Marshal.PtrToStructure(current, GetType(DHCP_IP_ADDRESS)), DHCP_IP_ADDRESS)
                Marshal.DestroyStructure(current, GetType(DHCP_IP_ADDRESS))
                current = current + Marshal.SizeOf(ipAddressesArray(i))
                Debug.WriteLine(i &amp; " " &amp; IPConvert(ipAddressesArray(i).IPAddress))
                StringsToReturn(i) = IPConvert(ipAddressesArray(i).IPAddress)
            Next
            Marshal.FreeCoTaskMem(outArray)
            Debug.WriteLine("Elements read " &amp; nr &amp; " out of " &amp; Total)
        Else
            Debug.WriteLine("Failed!")
        End If
        Return StringsToReturn
    End Function
    Public Function getSubNetInfo(ByVal Subnet As Integer) As Integer
        Dim Result As DHCP_SUBNET_INFO
        Dim code As Integer
        Try
            code = DhcpGetSubnetInfo("10.10.10.10", Subnet, Result)
            msgbox(Result.SubnetName)
        Catch
            msgbox(Err.Description)
        End Try
    End Function
    Public Shared Function EnumServers() As DHCPDS_SERVER()
        Dim retVal As UInt32 = 0
        Dim servers As IntPtr
        Try
            DhcpEnumServers(0, Nothing, servers, Nothing, Nothing)
        Catch ex As Exception
            Throw New Exception("Error code:  " &amp; retVal.ToString, ex)
        End Try
        If retVal = 0 And servers &lt;&gt; IntPtr.Zero Then
            Dim serverArray As DHCPDS_SERVERS = _
              CType(Marshal.PtrToStructure(servers, GetType(DHCPDS_SERVERS)), DHCPDS_SERVERS)
            Dim serverList(CType(serverArray.NumElements, Int32)) As DHCPDS_SERVER
            Dim current As IntPtr = serverArray.Servers
            For i As Int32 = 0 To CType(serverArray.NumElements - 1, Int32)
                serverList(i) = CType(Marshal.PtrToStructure(current, GetType(DHCPDS_SERVER)), DHCPDS_SERVER)
                Debug.WriteLine("ServerName: " &amp; serverList(i).ServerName)
                Debug.WriteLine("ServerAddress: " &amp; serverList(i).ServerAddress)
                Debug.WriteLine("ServerState: " &amp; serverList(i).State)
                Debug.WriteLine("ServerVersion: " &amp; serverList(i).Version)
                Debug.WriteLine("ServerDsLocation: " &amp; serverList(i).DsLocation)
                Debug.WriteLine("ServerDsLocType: " &amp; serverList(i).DsLocType)
                Debug.WriteLine("ServerFlags: " &amp; serverList(i).Flags)
                Debug.WriteLine(vbCrLf &amp; vbCrLf)
                Marshal.DestroyStructure(current, GetType(DHCPDS_SERVER))
                current = IntPtr.op_Explicit(current.ToInt64() + Marshal.SizeOf(serverList(i)))
            Next
            Marshal.FreeCoTaskMem(servers)
            Return serverList
        ElseIf retVal = 0 And servers = IntPtr.Zero Then
            Throw New Exception("No servers found.")
        Else
            Throw New Exception("Error code:  " &amp; retVal.ToString)
        End If
    End Function
    Public Sub ListSubnetClients(ByVal ServerIP As String, ByVal SubnetIP As String)
        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 ?
        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 UInt32
        'Scope_I = "10.0.3.0"
        Scope_I = StringIPAddressToUInt32(SubnetIP) ' Dot2LongIP(SubnetIP)
        'Call dhcpsapi
        Error_Code = DhcpEnumSubnetClients(ServerIP, 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)
        Dim MacAddr As Net.NetworkInformation.PhysicalAddress
        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))
            'MacAddr = Net.NetworkInformation.PhysicalAddress.Parse(DHCP_Clients(i).ClientHardwareAddress.Data)
            'If HardwareAddress = "ec-30-91-d5-f0-a6" Then
            'System.Diagnostics.Debugger.Break()
            'ElseIf HardwareAddress.StartsWith("ec-30-91") Then
            'System.Diagnostics.Debugger.Break()
            'End If
            Dim IsClientReserved As Boolean
            If DHCP_Clients(i).ClientLeaseExpires.dwLowDateTime = 4294967295 And DHCP_Clients(i).ClientLeaseExpires.dwHighDateTime = 2147483647 Then
                IsClientReserved = True
            Else
                IsClientReserved = False
            End If
            Dim IsClientInActivelyReserved As Boolean
            If DHCP_Clients(i).ClientLeaseExpires.dwLowDateTime = 0 And DHCP_Clients(i).ClientLeaseExpires.dwHighDateTime = 0 Then
                IsClientInActivelyReserved = True
            Else
                IsClientInActivelyReserved = False
            End If
            Dim HardwareAddress As String = String.Format("{0:x2}-{1:x2}-{2:x2}-{3:x2}-{4:x2}-{5:x2}", Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 1), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 2), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 3), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 4), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 5))
            Dim NetShHardwareAddress As String = String.Format("{0:x2}{1:x2}{2:x2}{3:x2}{4:x2}{5:x2}", Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 1), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 2), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 3), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 4), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 5))
            Debug.WriteLine("ClientComment: " &amp; DHCP_Clients(i).ClientComment)
            Debug.WriteLine("ClientIpAddress: " &amp; IPConvert(DHCP_Clients(i).ClientIpAddress))
            Debug.WriteLine("ClientHardwareAddress: " &amp; HardwareAddress)
            Debug.WriteLine("ClientLeaseExpires: " &amp; DHCP_Clients(i).ClientLeaseExpires.ConvertIntToDateTime)
            Debug.WriteLine("ClientName: " &amp; DHCP_Clients(i).ClientName)
            Debug.WriteLine("OwnerHoost-&gt;HostName: " &amp; DHCP_Clients(i).OwnerHost.HostName)
            Debug.WriteLine("OwnerHost-&gt;IpAddress: " &amp; IPConvert(DHCP_Clients(i).OwnerHost.IpAddress))
            Debug.WriteLine("OwnerHost-&gt;NetBiosName: " &amp; DHCP_Clients(i).OwnerHost.NetBiosName)
            Debug.WriteLine("SubnetMask: " &amp; UInt32IPAddressToString(DHCP_Clients(i).SubnetMask))
            'ConvertTolease
            'IPConvert(DHCP_Clients(i).ClientIpAddress).ToString.Trim = "10.246.36.101" And
            If (Not IsClientReserved And Not IsClientInActivelyReserved) Then
                Dim MyArgs As String = vbNullString
                If Not IsNothing(DHCP_Clients(i).ClientComment) Then
                    Select Case DHCP_Clients(i).ClientComment.Trim
                        Case ""
                            MyArgs = "dhcp server 10.10.10.10 Scope " &amp; SubnetIP.ToString.Trim &amp; " Add reservedip " &amp; IPConvert(DHCP_Clients(i).ClientIpAddress).ToString.Trim &amp; " " &amp; NetShHardwareAddress.ToString &amp; " """ &amp; DHCP_Clients(i).ClientName &amp; """ ""Set for InfoBlox"" DHCP"
                        Case "This address is already in use"
                            HowManyClientsHaveBadAddresses += 1
                        Case Else
                            MyArgs = "dhcp server 10.10.10.10 Scope " &amp; SubnetIP.ToString.Trim &amp; " Add reservedip " &amp; IPConvert(DHCP_Clients(i).ClientIpAddress).ToString.Trim &amp; " " &amp; NetShHardwareAddress.ToString &amp; " """ &amp; DHCP_Clients(i).ClientName &amp; """ """ &amp; DHCP_Clients(i).ClientComment.ToString.Trim &amp; """ DHCP"
                    End Select
                Else
                    MyArgs = "dhcp server 10.10.10.10 Scope " &amp; SubnetIP.ToString.Trim &amp; " Add reservedip " &amp; IPConvert(DHCP_Clients(i).ClientIpAddress).ToString.Trim &amp; " " &amp; NetShHardwareAddress.ToString &amp; " """ &amp; DHCP_Clients(i).ClientName &amp; """ ""Set for InfoBlox"" DHCP"
                End If
                If MyArgs IsNot Nothing Then
                    Debug.WriteLine("netsh " &amp; MyArgs)
                    Dim MyProcess As New Process
                    MyProcess = Process.Start("netsh", MyArgs)
                    MyProcess.WaitForExit()
                    MachinesThatWillChange &amp;= DHCP_Clients(i).ClientName &amp; "," &amp; IPConvert(DHCP_Clients(i).ClientIpAddress) &amp; "," &amp; NetShHardwareAddress &amp; vbCrLf
                    HowManyClientsAreNeedToBechanged += 1
                Else
                    MachinesThatWillNotChange &amp;= DHCP_Clients(i).ClientName &amp; "," &amp; IPConvert(DHCP_Clients(i).ClientIpAddress) &amp; "," &amp; NetShHardwareAddress &amp; "," &amp; DHCP_Clients(i).ClientLeaseExpires.ConvertIntToDateTime &amp; vbCrLf
                    Debug.WriteLine("This unit has a BAD Address - Skipping")
                End If
            Else
                MachinesThatWillNotChange &amp;= DHCP_Clients(i).ClientName &amp; "," &amp; IPConvert(DHCP_Clients(i).ClientIpAddress) &amp; "," &amp; NetShHardwareAddress &amp; "," &amp; DHCP_Clients(i).ClientLeaseExpires.ConvertIntToDateTime &amp; vbCrLf
                Debug.WriteLine("No NETSH command required")
                HowManyClientsAreAlreadyReserved += 1
            End If
            Debug.WriteLine(vbCrLf &amp; vbCrLf)
            pt = IntPtr.Zero
            j = j + 4
            HowManyClients += 1
        Next i
    End Sub
    Private Sub ConvertTolease(ByVal DHCP_Clients() As DHCP_CLIENT_INFO, ByVal I As Integer)
        If IPConvert(DHCP_Clients(i).ClientIpAddress).ToString.Trim = "10.10.10.10" And False Then
            Dim DHCPv4 As New DHCP_CLIENT_INFOV4
            DHCPv4.bClientType = DHCP_CLIENT_TYPE.CLIENT_TYPE_BOTH
            DHCPv4.ClientComment = DHCP_Clients(i).ClientComment
            DHCPv4.ClientHardwareAddress = DHCP_Clients(i).ClientHardwareAddress
            DHCPv4.ClientIpAddress = DHCP_Clients(i).ClientIpAddress
            DHCPv4.ClientLeaseExpires = DHCP_Clients(i).ClientLeaseExpires
            DHCPv4.ClientName = DHCP_Clients(i).ClientName
            DHCPv4.OwnerHost = DHCP_Clients(i).OwnerHost
            DHCPv4.SubnetMask = DHCP_Clients(i).SubnetMask
            'Dim MyPtrr As IntPtr = Marshal.AllocHGlobal(Marshal.SizeOf(New DHCP_CLIENT_INFOV4))
            'DHCPv4.ClientLeaseExpires.SetToReserved()
            'DHCPv4.ClientLeaseExpires.SetToInfinte()
            'Marshal.StructureToPtr(DHCPv4, MyPtrr, False)
            'Debug.WriteLine("Lease Updated: " &amp; DhcpSetClientInfo(ServerIP, MyPtrr))
            'Debug.WriteLine("Lease Updated: " &amp; DhcpSetClientInfoV4(ServerIP, MyPtrr))
        End If
    End Sub
    ''' &lt;summary&gt;
    '''
    ''' &lt;/summary&gt;
    ''' &lt;param name="sender"&gt;&lt;/param&gt;
    ''' &lt;param name="e"&gt;&lt;/param&gt;
    ''' &lt;remarks&gt;&lt;/remarks&gt;
    '''
    Public Structure DHCP_SEARCH_INFO
        Dim DHCPSearchInfoType As Integer
        Dim DHCPIPAddress As UInt32
    End Structure
    Private Enum DHCP_SEARCH_INFO_TYPE
        DhcpClientIpAddress
        DhcpClientHardwareAddress
        DhcpClientName
    End Enum
    Public Function GetClientInfo(ByVal serverIP As String, ByVal clientIP As String)
        Dim DHCPResult As UInt32 = 0
        Try
            Dim searchInfo As New DHCP_SEARCH_INFO
            Dim searchInfoType As DHCP_SEARCH_INFO_TYPE = DHCP_SEARCH_INFO_TYPE.DhcpClientIpAddress
            searchInfo.DHCPSearchInfoType = searchInfoType
            searchInfo.DHCPIPAddress = Dot2LongIP(clientIP)
            Dim hClientInfo As IntPtr
            DHCPResult = DhcpGetClientInfo(serverIP, searchInfo, hClientInfo)
            If DHCPResult = 0 And Not hClientInfo = IntPtr.Zero Then
                Dim clientInfo As DHCP_CLIENT_INFO = Marshal.PtrToStructure(hClientInfo, GetType(DHCP_CLIENT_INFO))
                Debug.WriteLine("ClientInfo-&gt;clientInfo.ClientHardwareAddress " &amp; String.Format("{0:x2}-{1:x2}-{2:x2}-{3:x2}-{4:x2}-{5:x2}", Marshal.ReadByte(clientInfo.ClientHardwareAddress.Data), Marshal.ReadByte(clientInfo.ClientHardwareAddress.Data, 1), Marshal.ReadByte(clientInfo.ClientHardwareAddress.Data, 2), Marshal.ReadByte(clientInfo.ClientHardwareAddress.Data, 3), Marshal.ReadByte(clientInfo.ClientHardwareAddress.Data, 4), Marshal.ReadByte(clientInfo.ClientHardwareAddress.Data, 5)))
                Debug.WriteLine("ClientInfo-&gt;clientInfo.ClientIpAddress " &amp; IPConvert(clientInfo.ClientIpAddress))
                Debug.WriteLine("ClientInfo-&gt;clientInfo.ClientLeaseExpires " &amp; clientInfo.ClientLeaseExpires.ConvertIntToDateTime)
                Debug.WriteLine("ClientInfo-&gt;clientInfo.ClientName " &amp; clientInfo.ClientName)
                Debug.WriteLine("ClientInfo-&gt;clientInfo.OwnerHost-&gt;HostName " &amp; clientInfo.OwnerHost.HostName)
                Debug.WriteLine("ClientInfo-&gt;clientInfo.OwnerHost-&gt;IpAddress " &amp; IPConvert(clientInfo.OwnerHost.IpAddress))
                Debug.WriteLine("ClientInfo-&gt;clientInfo.OwnerHost-&gt;NetBiosName " &amp; clientInfo.OwnerHost.NetBiosName)
                Debug.WriteLine("ClientInfo-&gt;clientInfo.SubnetMask " &amp; clientInfo.SubnetMask)
                Debug.WriteLine("ClientInfo-&gt;clientInfo.ClientComment " &amp; clientInfo.ClientComment)
                Return (clientInfo)
            End If
            Return Nothing
        Catch ex As Exception
            Console.WriteLine(ex.Message)
            Return Nothing
        End Try
    End Function
    Private Sub EnumAll()
        Dim ListOfSubnets As String() = GetSubnets(ServerIPAddress)
        For Each Subnet As String In ListOfSubnets
            If Subnet = "0.0.0.0" Then
                Exit Sub
            End If
            If Subnet = "10.246.10.0" Or True Then
                ListSubnetClients(ServerIPAddress, Subnet)
            End If
        Next
    End Sub
    Public Sub CompareFirewallRules()
        Dim FileContents = GetFileContents("\\fileshare1\ISStaff\Network\KDB\Config\EMC-ASA.txt")
        Dim h As System.Net.IPHostEntry = System.Net.Dns.GetHostByName(System.Net.Dns.GetHostName)
        For Each IPString As System.Net.IPAddress In h.AddressList
            'Debug.WriteLine(IPString.ToString)
            If InStr(FileContents, IPString.ToString) &gt; 0 Then
                'Debug.WriteLine(IPString.ToString &amp; " - IP Found in Firewall Rules")
                TextBox1.Text += IPString.ToString &amp; " - IP Found in Firewall Rules"
            End If
        Next
        If TextBox1.Text = vbNullString Then TextBox1.Text = "No Firewall Rules Found!"
    End Sub
    Public Shared Function StringIPAddressToUInt32(ByVal ip_string As String) As UInteger
        Dim IpA As Net.IPAddress = System.Net.IPAddress.Parse(ip_string)
        Dim ip_bytes As Byte() = IpA.GetAddressBytes()
        Dim ip_uint As UInteger = CUInt(ip_bytes(0)) &lt;&lt; 24
        ip_uint += CUInt(ip_bytes(1)) &lt;&lt; 16
        ip_uint += CUInt(ip_bytes(2)) &lt;&lt; 8
        ip_uint += CUInt(ip_bytes(3))
        Return ip_uint
    End Function
    Public Shared Function UInt32IPAddressToString(ByVal ipAddress As UInteger) As String
        Dim ipA As New Net.IPAddress(ipAddress)
        Dim sIp As String() = ipA.ToString().Split("."c)
        Return sIp(3) &amp; "." &amp; sIp(2) &amp; "." &amp; sIp(1) &amp; "." &amp; sIp(0)
    End Function
    Public Function Dot2LongIP(ByVal DottedIP As String) As Integer
        Dim arrDec() As String
        Dim i As Integer
        Dim intResult As Integer
        If DottedIP = "" Then
            Dot2LongIP = 0
        Else
            arrDec = DottedIP.Split(".")
            For i = arrDec.Length - 1 To 0 Step -1
                intResult = intResult + ((Int(arrDec(i)) Mod 256) * Math.Pow(256, 3 - i))
            Next
            Dot2LongIP = intResult
        End If
    End Function
    Public Function IPConvert(ByVal IPAddress As Object) As Object
        Dim x As Integer
        Dim Pos As Integer
        Dim PrevPos As Integer
        Dim Num As Integer
        If IsNumeric(IPAddress) Then
            IPConvert = "0.0.0.0"
            For x = 1 To 4
                Num = Int(IPAddress / 256 ^ (4 - x))
                IPAddress = IPAddress - (Num * 256 ^ (4 - x))
                If Num &gt; 255 Then
                    IPConvert = "0.0.0.0"
                    Exit Function
                End If
                If x = 1 Then
                    IPConvert = Num
                Else
                    IPConvert = IPConvert &amp; "." &amp; Num
                End If
            Next
        ElseIf UBound(Split(IPAddress, ".")) = 3 Then
            '        On Error Resume Next
            For x = 1 To 4
                Pos = InStr(PrevPos + 1, IPAddress, ".", 1)
                If x = 4 Then Pos = Len(IPAddress) + 1
                Num = Int(Mid(IPAddress, PrevPos + 1, Pos - PrevPos - 1))
                If Num &gt; 255 Then
                    IPConvert = "0"
                    Exit Function
                End If
                PrevPos = Pos
                IPConvert = ((Num Mod 256) * (256 ^ (4 - x))) + IPConvert
            Next
        End If
    End Function
    Public Function GetFileContents(ByVal FullPath As String, Optional ByRef ErrInfo As String = "") As String
        Dim strContents As String
        Dim objReader As System.IO.StreamReader
        Try
            objReader = New System.IO.StreamReader(FullPath)
            strContents = objReader.ReadToEnd()
            objReader.Close()
            Return strContents
        Catch Ex As Exception
            ErrInfo = Ex.Message
        End Try
    End Function
End Class

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

315

316

317

318

319

320

321

322

323

324

325

326

327

328

329

330

331

332

333

334

335

336

337

338

339

340

341

342

343

344

345

346

347

348

349

350

351

352

353

354

355

356

357

358

359

360

361

362

363

364

365

366

367

368

369

370

371

372

373

374

375

376

377

378

379

380

381

382

383

384

385

386

387

388

389

390

391

392

393

394

395

396

397

398

399

400

401

402

403

404

405

406

407

408

409

410

411

412

413

414

415

416

417

418

419

420

421

422

423

424

425

426

427

428

429

430

431

432

433

434

435

436

437

438

439

440

441

442

443

444

445

446

447

448

449

450

451

452

453

454

455

456

457

458

459

460

461

462

463

464

465

466

467

468

469

470

471

472

473

474

475

476

477

478

479

480

481

482

483

484

485

486

487

488

489

490

491

492

493

494

495

496

497

498

499

500

501

502

503

504

505

506

507

508

509

510

511

512

513

514

515

516

517

518

519

520

521

522

523

524

525

526

527

528

529

530

531

532

533

534

535

536

537

538

539

540

541

542

543

544

545

546

547

548

549

550

551

552

553

554

555

556

Imports System.Runtime.InteropServices

Public Class Form1

'http://social.msdn.microsoft.com/Forums/en-US/512c7fc3-fb32-4081-a8c2-451883abe9fb/dhcpclientinfovq-bclienttype

Declare Unicode Function DhcpEnumSubnetClients Lib "dhcpsapi" (ByVal ServerIpAddress As String, ByVal SubnetAddress As UInt32, ByRef ResumeHandle As IntPtr, ByVal PreferredMaximum As Integer, ByRef ClientInfo As IntPtr, ByRef ClientsRead As Integer, ByRef ClientsTotal As Integer) As Integer

<DllImport("dhcpsapi.dll", SetLastError:=True, CharSet:=CharSet.Unicode)> _

Public Shared Function DhcpSetClientInfo( _

ByVal ServerIpAddress As String, _

ByVal ClientInfo As IntPtr) As UInt32

End Function

<DllImport("dhcpsapi.dll", SetLastError:=True, CharSet:=CharSet.Unicode)> _

Public Shared Function DhcpSetClientInfoV4( _

ByVal ServerIpAddress As String, _

ByVal ClientInfoV4 As IntPtr) As UInt32

End Function

<DllImport("dhcpsapi.dll", SetLastError:=True, CharSet:=CharSet.Unicode)> _

Public Shared Function DhcpGetClientInfo( _

ByVal ServerIpAddress As String, _

ByRef SearchInfo As DHCP_SEARCH_INFO, _

ByRef ClientInfo As IntPtr) As UInt32

End Function

<DllImport("dhcpsapi.dll", SetLastError:=True, CharSet:=CharSet.Unicode)> _

Public Shared Function DhcpSetClientInfoVQ( _

ByVal ServerIpAddress As String, _

ByVal ClientInfo As IntPtr) As UInt32

End Function

<StructLayout(LayoutKind.Sequential)> _

Private Structure DHCP_IP_ARRAY

Dim NumElements As Int32

Dim Elements As IntPtr

End Structure

<StructLayout(LayoutKind.Sequential)> _

Private Structure DHCP_CLIENT_INFO_ARRAY

Dim NumElements As Integer

Dim Clients As IntPtr

End Structure

<StructLayout(LayoutKind.Sequential)> _

Private Structure DHCP_CLIENT_INFO

Dim ClientIpAddress As UInt32

Dim SubnetMask As UInt32

Dim ClientHardwareAddress As DHCP_BINARY_DATA

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

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

Dim ClientLeaseExpires As MyDate_Time

Dim OwnerHost As DHCP_HOST_INFO

End Structure

<StructLayout(LayoutKind.Sequential)> _

Private Structure DHCP_CLIENT_INFOV4

Dim ClientIpAddress As UInt32

Dim SubnetMask As UInt32

Dim ClientHardwareAddress As DHCP_BINARY_DATA

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

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

Dim ClientLeaseExpires As MyDate_Time

Dim OwnerHost As DHCP_HOST_INFO

Dim bClientType As DHCP_CLIENT_TYPE

End Structure

<StructLayout(LayoutKind.Sequential)> _

Public Structure DHCP_CLIENT_INFO_ARRAY_VQ

Dim NumElements As Integer

Dim Clients As IntPtr

End Structure

<StructLayout(LayoutKind.Sequential)> _

Private Structure DHCP_CLIENT_INFO_VQ

Dim ClientIpAddress As UInt32

Dim SubnetMask As UInt32

Dim ClientHardwareAddress As DHCP_BINARY_DATA

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

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

Dim ClientLeaseExpires As MyDate_Time

Dim OwnerHost As DHCP_HOST_INFO

Dim bClientType As DHCP_CLIENT_TYPE

Dim AddressState As Byte

Dim Status As DHCP_QuarantineStatus

Dim ProbationEnds As MyDate_Time

Dim QuarantineCapable As Boolean

End Structure

Enum DHCP_CLIENT_TYPE As Byte

CLIENT_TYPE_DHCP = 1

CLIENT_TYPE_BOOTP = 2

CLIENT_TYPE_BOTH = 3

CLIENT_TYPE_RESERVATION_FLAG = 4

CLIENT_TYPE_NONE = &H64

End Enum

Enum DHCP_AddressState As Byte

CLIENT_TYPE_DHCP = 1

CLIENT_TYPE_BOOTP = 2

CLIENT_TYPE_BOTH = 3

CLIENT_TYPE_RESERVATION_FLAG = 4

CLIENT_TYPE_NONE = &H64

End Enum

Enum DHCP_QuarantineStatus As Byte

NOQUARANTINE = 0

RESTRICTEDACCESS = 1

DROPPACKET = 2

PROBATION = 3

EXEMPT = 4

DEFAULTQUARSETTING = 5

NOQUARINFO = 6

End Enum

<StructLayout(LayoutKind.Sequential)> _

Structure DHCP_DATE_TIME

Dim dwLowDateTime As Integer

Dim dwHighDateTime As Integer

End Structure

<StructLayout(LayoutKind.Sequential)> _

Structure DHCP_BINARY_DATA

Dim DataLength As Int32

Dim Data As IntPtr

End Structure

<StructLayout(LayoutKind.Sequential)> _

Private Structure MyDate_Time

<MarshalAs(UnmanagedType.U4)> _

Dim dwLowDateTime As UInt32

<MarshalAs(UnmanagedType.U4)> _

Dim dwHighDateTime As UInt32

Public Function ConvertIntToDateTime() As DateTime

If dwHighDateTime = 0 And dwLowDateTime = 0 Then Return DateTime.MinValue

If dwHighDateTime = Int32.MaxValue And dwLowDateTime = UInt32.MaxValue Then Return DateTime.MaxValue

Dim value As Long = dwHighDateTime

value <<= 32

value += dwLowDateTime

Return DateTime.FromFileTime(value)

End Function

Public Sub SetToReserved()

dwLowDateTime = 0

dwHighDateTime = 0

'Return DateTime.FromFileTime(value)

End Sub

Public Sub SetToInfinte()

dwLowDateTime = 4294967295

dwHighDateTime = 2147483647

'Return DateTime.FromFileTime(value)

End Sub

End Structure

<StructLayout(LayoutKind.Sequential)> _

Structure DHCP_HOST_INFO

Dim IpAddress As Int32

<MarshalAs(UnmanagedType.LPWStr)> _

Dim NetBiosName As String

<MarshalAs(UnmanagedType.LPWStr)> _

Dim HostName As String

End Structure

''' <summary>

''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''' DHCP SERVER STRUCTS

''' </summary>

''' <remarks></remarks>

<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)> _

Public Structure DHCPDS_SERVER

Dim Version As UInt32

Dim ServerName As String

Dim ServerAddress As UInt32

Dim Flags As UInt32

Dim State As UInt32

Dim DsLocation As String

Dim DsLocType As UInt32

End Structure

<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)> _

Public Structure DHCPDS_SERVERS

Dim Flags As UInt32

Dim NumElements As UInt32

Dim Servers As IntPtr

End Structure

Declare Unicode Function DhcpEnumServers Lib "Dhcpsapi.dll" (ByVal Flags As UInt32, _

ByVal IdInfo As IntPtr, _

ByRef Servers As IntPtr, _

ByVal CallbackFn As IntPtr, _

ByVal CallbackData As IntPtr) As UInt32

''' <summary>

''' Sumery

''' </summary>

''' <returns></returns>

''' <remarks></remarks>

'''

<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)> _

Public Structure DHCP_IP_ADDRESS

Dim IPAddress As UInteger

End Structure

''' <summary>

''' Sumery

''' </summary>

''' <returns></returns>

''' <remarks></remarks>

'''

<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)> Public Structure DHCP_SUBNET_INFO

Public SubnetAddress As UInteger

Public SubnetMask As UInteger

Public SubnetName As String

Public SubnetComment As String

'Public PrimaryHost As DHCP_HOST_INFO

Public SubnetState As DHCP_SUBNET_STATE

End Structure

Public Enum DHCP_SUBNET_STATE

DhcpSubnetEnabled = 0

DhcpSubnetDisabled = 1

DhcpSubnetEnabledSwitched = 2

DhcpSubnetDisabledSwitched = 3

DhcpSubnetInvalidState = 4

End Enum

Public Declare Unicode Function DhcpGetSubnetInfo Lib "Dhcpsapi" (ByVal ServerIpAddress As String, ByVal SubnetAddress As Integer, ByRef SubnetInfo As DHCP_SUBNET_INFO) As Integer

Public Declare Unicode Function DhcpEnumSubnets Lib "Dhcpsapi" (ByVal ServerIpAddress As String, ByRef ResumeHandle As Integer, ByVal PreferredMaximum As Integer, ByRef EnumInfo As IntPtr, ByRef ElementsRead As Integer, ByRef ElementsTotal As Integer) As Integer

Dim HowManyClients As Long = 0

Dim HowManyClientsAreAlreadyReserved As Long = 0

Dim HowManyClientsAreNeedToBechanged As Long = 0

Dim HowManyClientsHaveBadAddresses As Long = 0

Dim MachinesThatWillChange As String = vbNullString

Dim MachinesThatWillNotChange As String = vbNullString

Dim ServerIPAddress As String = "10.10.10.10"

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

Dim ts = Stopwatch.StartNew

' Your code goes here

EnumAll()

Debug.WriteLine("How many clients: " & HowManyClients)

Debug.WriteLine("How many clients are already reserved: " & HowManyClientsAreAlreadyReserved)

Debug.WriteLine("How many clients need to be changed: " & (HowManyClientsAreNeedToBechanged - HowManyClientsHaveBadAddresses))

Debug.WriteLine("How many clients have bad addresses: " & HowManyClientsHaveBadAddresses)

Debug.WriteLine("-----------------------------------------------------------------------")

Debug.WriteLine("Machines that will change")

Debug.WriteLine(MachinesThatWillChange)

Debug.WriteLine("-----------------------------------------------------------------------")

Debug.WriteLine("Machines that will NOT change")

Debug.WriteLine(MachinesThatWillNotChange)

' Format and display the TimeSpan value.

Dim myelapsedTime As String = String.Format("{0:00}:{1:00}:{2:00}.{3:00}", ts.Elapsed.Hours, ts.Elapsed.Minutes, ts.Elapsed.Seconds, ts.Elapsed.Milliseconds / 10)

Debug.WriteLine("RunTime " & myelapsedTime)

'EnumServers()

'GetSubnets("10.10.10.10")

'ListSubnetClients("10.10.10.10", "10.10.10.100")

'CompareFirewallRules()

'GetClientInfo("10.10.10.10", "10.10.10.100")

End Sub

Public Function GetSubnets(ByVal ServerIp As String) As String()

Dim StringsToReturn() As String

Dim ServerIpAddress = ServerIp

Dim DHCPResult As UInt32 = 0

Dim IPS As IntPtr

Dim nr As UInteger = 0

Dim Total As UInteger = 0

Dim resumehandle As UInteger = 0

DHCPResult = DhcpEnumSubnets(ServerIpAddress, resumehandle, 1000, IPS, nr, Total)

If DHCPResult = 0 Then

Dim iparray As DHCP_IP_ARRAY = CType(Marshal.PtrToStructure(IPS, GetType(DHCP_IP_ARRAY)), DHCP_IP_ARRAY)

Dim Size As Integer = iparray.NumElements

Dim outArray As IntPtr = iparray.Elements

Dim ipAddressesArray(Size) As DHCP_IP_ADDRESS

Array.Resize(StringsToReturn, Size + 1)

Dim current As IntPtr = outArray

For i = 0 To Size

ipAddressesArray(i) = New DHCP_IP_ADDRESS

ipAddressesArray(i) = CType(Marshal.PtrToStructure(current, GetType(DHCP_IP_ADDRESS)), DHCP_IP_ADDRESS)

Marshal.DestroyStructure(current, GetType(DHCP_IP_ADDRESS))

current = current + Marshal.SizeOf(ipAddressesArray(i))

Debug.WriteLine(i & " " & IPConvert(ipAddressesArray(i).IPAddress))

StringsToReturn(i) = IPConvert(ipAddressesArray(i).IPAddress)

Marshal.FreeCoTaskMem(outArray)

Debug.WriteLine("Elements read " & nr & " out of " & Total)

Else

Debug.WriteLine("Failed!")

End If

Return StringsToReturn

End Function

Public Function getSubNetInfo(ByVal Subnet As Integer) As Integer

Dim Result As DHCP_SUBNET_INFO

Dim code As Integer

Try

code = DhcpGetSubnetInfo("10.10.10.10", Subnet, Result)

msgbox(Result.SubnetName)

Catch

msgbox(Err.Description)

End Try

End Function

Public Shared Function EnumServers() As DHCPDS_SERVER()

Dim retVal As UInt32 = 0

Dim servers As IntPtr

Try

DhcpEnumServers(0, Nothing, servers, Nothing, Nothing)

Catch ex As Exception

Throw New Exception("Error code: " & retVal.ToString, ex)

End Try

If retVal = 0 And servers <> IntPtr.Zero Then

Dim serverArray As DHCPDS_SERVERS = _

CType(Marshal.PtrToStructure(servers, GetType(DHCPDS_SERVERS)), DHCPDS_SERVERS)

Dim serverList(CType(serverArray.NumElements, Int32)) As DHCPDS_SERVER

Dim current As IntPtr = serverArray.Servers

For i As Int32 = 0 To CType(serverArray.NumElements - 1, Int32)

serverList(i) = CType(Marshal.PtrToStructure(current, GetType(DHCPDS_SERVER)), DHCPDS_SERVER)

Debug.WriteLine("ServerName: " & serverList(i).ServerName)

Debug.WriteLine("ServerAddress: " & serverList(i).ServerAddress)

Debug.WriteLine("ServerState: " & serverList(i).State)

Debug.WriteLine("ServerVersion: " & serverList(i).Version)

Debug.WriteLine("ServerDsLocation: " & serverList(i).DsLocation)

Debug.WriteLine("ServerDsLocType: " & serverList(i).DsLocType)

Debug.WriteLine("ServerFlags: " & serverList(i).Flags)

Debug.WriteLine(vbCrLf & vbCrLf)

Marshal.DestroyStructure(current, GetType(DHCPDS_SERVER))

current = IntPtr.op_Explicit(current.ToInt64() + Marshal.SizeOf(serverList(i)))

Marshal.FreeCoTaskMem(servers)

Return serverList

ElseIf retVal = 0 And servers = IntPtr.Zero Then

Throw New Exception("No servers found.")

Else

Throw New Exception("Error code: " & retVal.ToString)

End If

End Function

Public Sub ListSubnetClients(ByVal ServerIP As String, ByVal SubnetIP As String)

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 ?

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 UInt32

'Scope_I = "10.0.3.0"

Scope_I = StringIPAddressToUInt32(SubnetIP) ' Dot2LongIP(SubnetIP)

'Call dhcpsapi

Error_Code = DhcpEnumSubnetClients(ServerIP, 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)

Dim MacAddr As Net.NetworkInformation.PhysicalAddress

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))

'MacAddr = Net.NetworkInformation.PhysicalAddress.Parse(DHCP_Clients(i).ClientHardwareAddress.Data)

'If HardwareAddress = "ec-30-91-d5-f0-a6" Then

'System.Diagnostics.Debugger.Break()

'ElseIf HardwareAddress.StartsWith("ec-30-91") Then

'System.Diagnostics.Debugger.Break()

'End If

Dim IsClientReserved As Boolean

If DHCP_Clients(i).ClientLeaseExpires.dwLowDateTime = 4294967295 And DHCP_Clients(i).ClientLeaseExpires.dwHighDateTime = 2147483647 Then

IsClientReserved = True

Else

IsClientReserved = False

End If

Dim IsClientInActivelyReserved As Boolean

If DHCP_Clients(i).ClientLeaseExpires.dwLowDateTime = 0 And DHCP_Clients(i).ClientLeaseExpires.dwHighDateTime = 0 Then

IsClientInActivelyReserved = True

Else

IsClientInActivelyReserved = False

End If

Dim HardwareAddress As String = String.Format("{0:x2}-{1:x2}-{2:x2}-{3:x2}-{4:x2}-{5:x2}", Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 1), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 2), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 3), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 4), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 5))

Dim NetShHardwareAddress As String = String.Format("{0:x2}{1:x2}{2:x2}{3:x2}{4:x2}{5:x2}", Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 1), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 2), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 3), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 4), Marshal.ReadByte(DHCP_Clients(i).ClientHardwareAddress.Data, 5))

Debug.WriteLine("ClientComment: " & DHCP_Clients(i).ClientComment)

Debug.WriteLine("ClientIpAddress: " & IPConvert(DHCP_Clients(i).ClientIpAddress))

Debug.WriteLine("ClientHardwareAddress: " & HardwareAddress)

Debug.WriteLine("ClientLeaseExpires: " & DHCP_Clients(i).ClientLeaseExpires.ConvertIntToDateTime)

Debug.WriteLine("ClientName: " & DHCP_Clients(i).ClientName)

Debug.WriteLine("OwnerHoost->HostName: " & DHCP_Clients(i).OwnerHost.HostName)

Debug.WriteLine("OwnerHost->IpAddress: " & IPConvert(DHCP_Clients(i).OwnerHost.IpAddress))

Debug.WriteLine("OwnerHost->NetBiosName: " & DHCP_Clients(i).OwnerHost.NetBiosName)

Debug.WriteLine("SubnetMask: " & UInt32IPAddressToString(DHCP_Clients(i).SubnetMask))

'ConvertTolease

'IPConvert(DHCP_Clients(i).ClientIpAddress).ToString.Trim = "10.246.36.101" And

If (Not IsClientReserved And Not IsClientInActivelyReserved) Then

Dim MyArgs As String = vbNullString

If Not IsNothing(DHCP_Clients(i).ClientComment) Then

Select Case DHCP_Clients(i).ClientComment.Trim

Case ""

MyArgs = "dhcp server 10.10.10.10 Scope " & SubnetIP.ToString.Trim & " Add reservedip " & IPConvert(DHCP_Clients(i).ClientIpAddress).ToString.Trim & " " & NetShHardwareAddress.ToString & " """ & DHCP_Clients(i).ClientName & """ ""Set for InfoBlox"" DHCP"

Case "This address is already in use"

HowManyClientsHaveBadAddresses += 1

Case Else

End Select

Else

End If

If MyArgs IsNot Nothing Then

Debug.WriteLine("netsh " & MyArgs)

Dim MyProcess As New Process

MyProcess = Process.Start("netsh", MyArgs)

MyProcess.WaitForExit()

MachinesThatWillChange &= DHCP_Clients(i).ClientName & "," & IPConvert(DHCP_Clients(i).ClientIpAddress) & "," & NetShHardwareAddress & vbCrLf

HowManyClientsAreNeedToBechanged += 1

Else

MachinesThatWillNotChange &= DHCP_Clients(i).ClientName & "," & IPConvert(DHCP_Clients(i).ClientIpAddress) & "," & NetShHardwareAddress & "," & DHCP_Clients(i).ClientLeaseExpires.ConvertIntToDateTime & vbCrLf

Debug.WriteLine("This unit has a BAD Address - Skipping")

End If

Else

Debug.WriteLine("No NETSH command required")

HowManyClientsAreAlreadyReserved += 1

End If

Debug.WriteLine(vbCrLf & vbCrLf)

pt = IntPtr.Zero

j = j + 4

HowManyClients += 1

Next i

End Sub

Private Sub ConvertTolease(ByVal DHCP_Clients() As DHCP_CLIENT_INFO, ByVal I As Integer)

If IPConvert(DHCP_Clients(i).ClientIpAddress).ToString.Trim = "10.10.10.10" And False Then

Dim DHCPv4 As New DHCP_CLIENT_INFOV4

DHCPv4.bClientType = DHCP_CLIENT_TYPE.CLIENT_TYPE_BOTH

DHCPv4.ClientComment = DHCP_Clients(i).ClientComment

DHCPv4.ClientHardwareAddress = DHCP_Clients(i).ClientHardwareAddress

DHCPv4.ClientIpAddress = DHCP_Clients(i).ClientIpAddress

DHCPv4.ClientLeaseExpires = DHCP_Clients(i).ClientLeaseExpires

DHCPv4.ClientName = DHCP_Clients(i).ClientName

DHCPv4.OwnerHost = DHCP_Clients(i).OwnerHost

DHCPv4.SubnetMask = DHCP_Clients(i).SubnetMask

'Dim MyPtrr As IntPtr = Marshal.AllocHGlobal(Marshal.SizeOf(New DHCP_CLIENT_INFOV4))

'DHCPv4.ClientLeaseExpires.SetToReserved()

'DHCPv4.ClientLeaseExpires.SetToInfinte()

'Marshal.StructureToPtr(DHCPv4, MyPtrr, False)

'Debug.WriteLine("Lease Updated: " & DhcpSetClientInfo(ServerIP, MyPtrr))

'Debug.WriteLine("Lease Updated: " & DhcpSetClientInfoV4(ServerIP, MyPtrr))

End If

End Sub

''' <summary>

'''

''' </summary>

''' <param name="sender"></param>

''' <param name="e"></param>

''' <remarks></remarks>

'''

Public Structure DHCP_SEARCH_INFO

Dim DHCPSearchInfoType As Integer

Dim DHCPIPAddress As UInt32

End Structure

Private Enum DHCP_SEARCH_INFO_TYPE

DhcpClientIpAddress

DhcpClientHardwareAddress

DhcpClientName

End Enum

Public Function GetClientInfo(ByVal serverIP As String, ByVal clientIP As String)

Dim DHCPResult As UInt32 = 0

Try

Dim searchInfo As New DHCP_SEARCH_INFO

Dim searchInfoType As DHCP_SEARCH_INFO_TYPE = DHCP_SEARCH_INFO_TYPE.DhcpClientIpAddress

searchInfo.DHCPSearchInfoType = searchInfoType

searchInfo.DHCPIPAddress = Dot2LongIP(clientIP)

Dim hClientInfo As IntPtr

DHCPResult = DhcpGetClientInfo(serverIP, searchInfo, hClientInfo)

If DHCPResult = 0 And Not hClientInfo = IntPtr.Zero Then

Dim clientInfo As DHCP_CLIENT_INFO = Marshal.PtrToStructure(hClientInfo, GetType(DHCP_CLIENT_INFO))

Debug.WriteLine("ClientInfo->clientInfo.ClientHardwareAddress " & String.Format("{0:x2}-{1:x2}-{2:x2}-{3:x2}-{4:x2}-{5:x2}", Marshal.ReadByte(clientInfo.ClientHardwareAddress.Data), Marshal.ReadByte(clientInfo.ClientHardwareAddress.Data, 1), Marshal.ReadByte(clientInfo.ClientHardwareAddress.Data, 2), Marshal.ReadByte(clientInfo.ClientHardwareAddress.Data, 3), Marshal.ReadByte(clientInfo.ClientHardwareAddress.Data, 4), Marshal.ReadByte(clientInfo.ClientHardwareAddress.Data, 5)))

Debug.WriteLine("ClientInfo->clientInfo.ClientIpAddress " & IPConvert(clientInfo.ClientIpAddress))

Debug.WriteLine("ClientInfo->clientInfo.ClientLeaseExpires " & clientInfo.ClientLeaseExpires.ConvertIntToDateTime)

Debug.WriteLine("ClientInfo->clientInfo.ClientName " & clientInfo.ClientName)

Debug.WriteLine("ClientInfo->clientInfo.OwnerHost->HostName " & clientInfo.OwnerHost.HostName)

Debug.WriteLine("ClientInfo->clientInfo.OwnerHost->IpAddress " & IPConvert(clientInfo.OwnerHost.IpAddress))

Debug.WriteLine("ClientInfo->clientInfo.OwnerHost->NetBiosName " & clientInfo.OwnerHost.NetBiosName)

Debug.WriteLine("ClientInfo->clientInfo.SubnetMask " & clientInfo.SubnetMask)

Debug.WriteLine("ClientInfo->clientInfo.ClientComment " & clientInfo.ClientComment)

Return (clientInfo)

End If

Return Nothing

Catch ex As Exception

Console.WriteLine(ex.Message)

Return Nothing

End Try

End Function

Private Sub EnumAll()

Dim ListOfSubnets As String() = GetSubnets(ServerIPAddress)

For Each Subnet As String In ListOfSubnets

If Subnet = "0.0.0.0" Then

Exit Sub

End If

If Subnet = "10.246.10.0" Or True Then

ListSubnetClients(ServerIPAddress, Subnet)

End If

End Sub

Public Sub CompareFirewallRules()

Dim FileContents = GetFileContents("\\fileshare1\ISStaff\Network\KDB\Config\EMC-ASA.txt")

Dim h As System.Net.IPHostEntry = System.Net.Dns.GetHostByName(System.Net.Dns.GetHostName)

For Each IPString As System.Net.IPAddress In h.AddressList

'Debug.WriteLine(IPString.ToString)

If InStr(FileContents, IPString.ToString) > 0 Then

'Debug.WriteLine(IPString.ToString & " - IP Found in Firewall Rules")

TextBox1.Text += IPString.ToString & " - IP Found in Firewall Rules"

End If

If TextBox1.Text = vbNullString Then TextBox1.Text = "No Firewall Rules Found!"

End Sub

Public Shared Function StringIPAddressToUInt32(ByVal ip_string As String) As UInteger

Dim IpA As Net.IPAddress = System.Net.IPAddress.Parse(ip_string)

Dim ip_bytes As Byte() = IpA.GetAddressBytes()

Dim ip_uint As UInteger = CUInt(ip_bytes(0)) << 24

ip_uint += CUInt(ip_bytes(1)) << 16

ip_uint += CUInt(ip_bytes(2)) << 8

ip_uint += CUInt(ip_bytes(3))

Return ip_uint

End Function

Public Shared Function UInt32IPAddressToString(ByVal ipAddress As UInteger) As String

Dim ipA As New Net.IPAddress(ipAddress)

Dim sIp As String() = ipA.ToString().Split("."c)

Return sIp(3) & "." & sIp(2) & "." & sIp(1) & "." & sIp(0)

End Function

Public Function Dot2LongIP(ByVal DottedIP As String) As Integer

Dim arrDec() As String

Dim i As Integer

Dim intResult As Integer

If DottedIP = "" Then

Dot2LongIP = 0

Else

arrDec = DottedIP.Split(".")

For i = arrDec.Length - 1 To 0 Step -1

intResult = intResult + ((Int(arrDec(i)) Mod 256) * Math.Pow(256, 3 - i))

Dot2LongIP = intResult

End If

End Function

Public Function IPConvert(ByVal IPAddress As Object) As Object

Dim x As Integer

Dim Pos As Integer

Dim PrevPos As Integer

Dim Num As Integer

If IsNumeric(IPAddress) Then

IPConvert = "0.0.0.0"

For x = 1 To 4

Num = Int(IPAddress / 256 ^ (4 - x))

IPAddress = IPAddress - (Num * 256 ^ (4 - x))

If Num > 255 Then

IPConvert = "0.0.0.0"

Exit Function

End If

If x = 1 Then

IPConvert = Num

Else

IPConvert = IPConvert & "." & Num

End If

ElseIf UBound(Split(IPAddress, ".")) = 3 Then

' On Error Resume Next

For x = 1 To 4

Pos = InStr(PrevPos + 1, IPAddress, ".", 1)

If x = 4 Then Pos = Len(IPAddress) + 1

Num = Int(Mid(IPAddress, PrevPos + 1, Pos - PrevPos - 1))

If Num > 255 Then

IPConvert = "0"

Exit Function

End If

PrevPos = Pos

IPConvert = ((Num Mod 256) * (256 ^ (4 - x))) + IPConvert

End If

End Function

Public Function GetFileContents(ByVal FullPath As String, Optional ByRef ErrInfo As String = "") As String

Dim strContents As String

Dim objReader As System.IO.StreamReader

Try

objReader = New System.IO.StreamReader(FullPath)

strContents = objReader.ReadToEnd()

objReader.Close()

Return strContents

Catch Ex As Exception

ErrInfo = Ex.Message

End Try

End Function

End Class

Enumerating Windows Native DHCP Server with VB.NET

Leave a comment

Cancel reply