Zjištění IP adresy DHCP serveru

Postup:
Private Const MAX_ADAPTER_NAME_LENGTH As Long = 256
Private Const MAX_ADAPTER_DESCRIPTION_LENGTH As Long = 128
Private Const MAX_ADAPTER_ADDRESS_LENGTH As Long = 8
Private Const ERROR_SUCCESS As Long = 0

Private Type IP_ADDRESS_STRING
    IpAddr(0 To 15) As Byte
End Type

Private Type IP_MASK_STRING
    IpMask(0 To 15) As Byte
End Type

Private Type IP_ADDR_STRING
    dwNext As Long
    IpAddress As IP_ADDRESS_STRING
    IpMask As IP_MASK_STRING
    dwContext As Long
End Type

Private Type IP_ADAPTER_INFO
  dwNext As Long
  ComboIndex As Long
  sAdapterName(0 To (MAX_ADAPTER_NAME_LENGTH + 3)) As Byte
  sDescription(0 To (MAX_ADAPTER_DESCRIPTION_LENGTH + 3)) As Byte
  dwAddressLength As Long
  sIPAddress(0 To (MAX_ADAPTER_ADDRESS_LENGTH - 1)) As Byte
  dwIndex As Long
  uType As Long
  uDhcpEnabled As Long
  CurrentIpAddress As Long
  IpAddressList As IP_ADDR_STRING
  GatewayList As IP_ADDR_STRING
  DhcpServer As IP_ADDR_STRING
  bHaveWins As Long
  PrimaryWinsServer As IP_ADDR_STRING
  SecondaryWinsServer As IP_ADDR_STRING
  LeaseObtained As Long
  LeaseExpires As Long
End Type

Private Declare Function GetAdaptersInfo Lib "iphlpapi.dll" _
  (pTcpTable As Any, _
   pdwSize As Long) As Long
   
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
  (dst As Any, _
   src As Any, _
   ByVal bcount As Long)
   
   
Private Function DhcpServerAddress() As String
   
   Dim cbRequired  As Long
   Dim buff()      As Byte
   Dim Adapter     As IP_ADAPTER_INFO
   Dim AdapterStr  As IP_ADDR_STRING
   Dim ptr1        As Long
   Dim ptr2        As Long
   Dim sIPAddr     As String
   Dim found       As Boolean
   
   Call GetAdaptersInfo(ByVal 0&, cbRequired)

   If cbRequired > 0 Then
      ReDim buff(0 To cbRequired - 1) As Byte
      If GetAdaptersInfo(buff(0), cbRequired) = ERROR_SUCCESS Then
         ptr1 = VarPtr(buff(0))
         Do While (ptr1 <> 0) And (found = False)
            CopyMemory Adapter, ByVal ptr1, LenB(Adapter)
            With Adapter
               If .uDhcpEnabled Then
                  ptr2 = VarPtr(.DhcpServer)
                  Do While (ptr2 <> 0)
                     CopyMemory AdapterStr, ByVal ptr2, LenB(AdapterStr)
                     With AdapterStr
                        sIPAddr = StrConv(.IpAddress.IpAddr, vbUnicode)
                        If Len(sIPAddr) > 0 Then
                           found = True
                           Exit Do
                        End If
                        ptr2 = .dwNext
                     End With  
                  Loop  
                  ptr1 = .dwNext
               End If 
            End With  
         Loop 
      End If 
   End If  

   DhcpServerAddress = sIPAddr
   
End Function

Zpět