Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal _
        wVersionRequired As Long, lpWSAData As WinSocketDataType) As Long
 
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
 
Private Declare Function gethostbyaddr Lib "WSOCK32.DLL" _
        (ByVal addr As String, ByVal laenge As Integer, ByVal typ As Integer) _
        As Long
 
Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As _
        Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
 
Const WS_VERSION_REQD As Long = &H101&
Const WSADescription_Len As Long = 256
Const WSASYS_Status_Len As Long = 128
 
Private Type HostDeType
    hName As Long
    hAliases As Long
    hAddrType As Integer
    hLength As Integer
    hAddrList As Long
End Type
 
 
Private Type WinSocketDataType
    wversion As Integer
    wHighVersion As Integer
    szDescription(0 To WSADescription_Len) As Byte
    szSystemStatus(0 To WSASYS_Status_Len) As Byte
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpszVendorInfo As Long
End Type
 
 
 
Public Sub InitSockets()
    Dim Result As Integer
    Dim LoBy As Integer, HiBy As Integer
    Dim SocketData As WinSocketDataType
 
    Result = WSAStartup(WS_VERSION_REQD, SocketData)
    If Result <> 0 Then
        Call MsgBox("'winsock.dll' antwortet nicht!")
        End
    End If
End Sub
 
Public Sub CleanSockets()
    Dim Result As Long
 
    Result = WSACleanup()
    If Result <> 0 Then
        Call MsgBox("Socket Error " & Trim$(Str$(Result)) & _
                " in Prozedur 'CleanSockets' aufgetreten !")
        End
    End If
End Sub
 
 
Public Function NextChar(Text$, Char$) As String
    Dim POS As Integer
 
    POS = InStr(1, Text, Char)
    If POS = 0 Then
        NextChar = Text
        Text = ""
    Else
        NextChar = Left$(Text, POS - 1)
        Text = Mid$(Text, POS + Len(Char))
    End If
End Function
 
Public Function HostByAddress(ByVal Addresse$) As String
    Dim X As Integer
    Dim HostDeAddress As Long
    Dim aa As String, BB As String * 5
    Dim HOST As HostDeType
 
    aa = Chr$(Val(NextChar(Addresse, ".")))
    aa = aa + Chr$(Val(NextChar(Addresse, ".")))
    aa = aa + Chr$(Val(NextChar(Addresse, ".")))
        aa = aa + Chr$(Val(Addresse))
 
    HostDeAddress = gethostbyaddr(aa, Len(aa), 2)
    If HostDeAddress = 0 Then
        HostByAddress = ""
        Exit Function
    End If
 
    Call RtlMoveMemory(HOST, HostDeAddress, LenB(HOST))
 
    aa = ""
    X = 0
    Do
       Call RtlMoveMemory(ByVal BB, HOST.hName + X, 1)
       If Left$(BB, 1) = Chr$(0) Then Exit Do
       aa = aa + Left$(BB, 1)
       X = X + 1
    Loop
 
    HostByAddress = aa
End Function

Call InitSockets
Label1.Caption = HostByAddress(Text1.Text)
CleanSockets