Private Sub GetIPs()
    Dim IP As String, Host As String
    Dim X As Integer
 
    Call InitSocketAPI
    Host = input_v
    List1.Clear
 
 
 
    Do
        IP = HostByName(Host, X)
'        If Len(IP) <> 0 Then List1.AddItem IP
        If Len(IP) <> 0 Then List1.AddItem IP
        X = X + 1
    Loop While Len(IP) > 0
 
    Call CleanSockets
End Sub
 
Private Sub InitSocketAPI()
    Dim Result 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
 
Private Function MyHostName() As String
    Dim HostName As String * 256
 
    If gethostname(HostName, 256) = SOCKET_ERROR Then
        MsgBox "Windows Sockets error " & Str(WSAGetLastError())
        Exit Function
    Else
        MyHostName = NextChar(Trim$(HostName), Chr$(0))
    End If
End Function
 
Private Function HostByName(Name As String, Optional X As Integer = 0) As String
    Dim MemIp() As Byte
    Dim y As Integer
    Dim HostDeAddress As Long, HostIp As Long
    Dim IpAddress As String
    Dim Host As HostDeType
 
    HostDeAddress = gethostbyname(Name)
    If HostDeAddress = 0 Then
        HostByName = ""
        Exit Function
    End If
 
    Call RtlMoveMemory(Host, HostDeAddress, LenB(Host))
 
    For y = 0 To X
        Call RtlMoveMemory(HostIp, Host.hAddrList + 4 * y, 4)
        If HostIp = 0 Then
            HostByName = ""
            Exit Function
        End If
    Next y
 
    ReDim MemIp(1 To Host.hLength)
    Call RtlMoveMemory(MemIp(1), HostIp, Host.hLength)
 
    IpAddress = ""
 
    For y = 1 To Host.hLength
        IpAddress = IpAddress & MemIp(y) & "."
    Next y
 
    IpAddress = Left$(IpAddress, Len(IpAddress) - 1)
    HostByName = IpAddress
End Function
 
Private 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
 
Private Function NextChar(Text As String, Char As String) 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