Private Type WSAData

    wVersion As Integer

    wHighVersion As Integer

    szDescription (0 To 256)

    szSystemStatus (0 To 128)

    wMaxSockets As Integer

    dwVendorInfo As Long

End Type



Private Declare Function WSAStartup Lib "WSOCK32.DLL" _

    (Byval wVersionRequired As Long, lpWSAData As WSAData) As Long

Private Declare Function WSACleanup Lib "WSOCK32.DLL" () AS Long

Private Declare Function gethostname Lib "WSOCK32.DLL" _

   (Byval szHost As String, Byval dwHostLen As Long) As Long

Private Declare Function gethostbyname Lib "WSOCK32.DLL" _

  (Byval szHost As String) As Long

'Achtung: Abgewandelte API-Funktion !!!

Private Declare Sub CopyMemoryIP Lib "kernel32" Alias _

   "RtlMoveMemory" (hpvDest As Any, Byval hpvSource As Long, _

   Byval cbCopy As Long)



Private Function GetIPAddress() As String

    Dim wsa As WSAData

    Dim rVal As Long

    Dim sHost As String * 256

    Dim lp As Long

    Dim lpa As Long

    Dim IpAdr(0 To 3) As Byte



    rVal = WSAStartup((2 + &H100), wsa)

    If rVal = 0 Then

        gethostname sHost, 256

        lp = gethostbyname(sHost)

        If lp Then

            CopyMemoryIP lpa, lp + 16, 4

            CopyMemoryIP IPAdr(0), lpa, 4

            GetIPAddress = CStr(IPAdr(0)) + "." + _

                                 CStr(IPAdr(1)) + "." + _

                                 CStr(IPAdr(2)) + "." + _

                                 CStr(IPAdr(3))

        End if  

        WSACleanup 

    End If

End Function