Const MAX_ADAPTER_NAME_LENGTH           As Long = 256
Const MAX_ADAPTER_DESCRIPTION_LENGTH    As Long = 128
Const MAX_ADAPTER_ADDRESS_LENGTH        As Long = 8
Const ERROR_SUCCESS                     As Long = 0
 
Type IP_ADDRESS_STRING
     IpAddr(0 To 15)                    As Byte
End Type
 
Type IP_MASK_STRING
     IpMask(0 To 15)                    As Byte
End Type
 
Type IP_ADDR_STRING
     dwNext                             As Long
     IpAddress                          As IP_ADDRESS_STRING
     IpMask                             As IP_MASK_STRING
     dwContext                          As Long
End Type
 
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
 
Declare Function GetAdaptersInfo Lib "iphlpapi.dll" _
                (pTcpTable As Any, _
                 pdwSize As Long) As Long
Declare Sub CopyMemory Lib "kernel32" Alias _
                "RtlMoveMemory" _
                (dst As Any, _
                 src As Any, _
                 ByVal bcount As Long)
 
Function LocalIPAddress() As String
 
   Dim lRequired  As Long
   Dim btBuffer()      As Byte
   Dim uAdapter     As IP_ADAPTER_INFO
 '  Dim AdapterStr  As IP_ADDR_STRING
 
   Dim lPtr        As Long
   Dim sIPAddr     As String
   Dim bFound       As Boolean
 
    Call GetAdaptersInfo(ByVal 0&, lRequired)
    If lRequired > 0 Then
        ReDim btBuffer(0 To lRequired - 1) As Byte
        If GetAdaptersInfo(btBuffer(0), lRequired) = ERROR_SUCCESS Then
    '// Pointer zu den Daten im btBuffer() Array ermitteln
        lPtr = VarPtr(btBuffer(0))
        Do While (lPtr <> 0) 'And (bFound = False)
        '// Speicherdaten kopieren
            CopyMemory uAdapter, ByVal lPtr, LenB(uAdapter)
            With uAdapter
                sIPAddr = _
                TrimNull(StrConv(.IpAddressList.IpAddress.IpAddr, vbUnicode))
                If Len(sIPAddr) > 0 Then
                    bFound = True
                    Exit Do
               End If
               lPtr = .dwNext
            End With  'With uAdapter
         Loop  'Do While (lPtr <> 0)
      End If   'If GetAdaptersInfo
   End If      'If lRequired > 0
   LocalIPAddress = sIPAddr
 
End Function
 
Private Function TrimNull(sValue As String)
 
    Dim iPos As Integer
    iPos = InStr(sValue, Chr$(0))
    If iPos Then
          TrimNull = Left$(sValue, iPos - 1)
    Else: TrimNull = sValue
    End If
 
End Function