Как получить название хоста по его ip или наоборот?

[Antonariy]

Пытаюсь так, но HOST.hLen всегда равно 0.

Код: Выделить всё

Private Function ResolveIPAddress(Name As String) As String
Dim sHostName As String * 256
Dim lpHost As Long
Dim HOST As HOSTENT
Dim dwIPAddr As Long
Dim tmpIPAddr() As Byte
Dim i As Integer
Dim sIPAddr As String
    sHostName = Trim$(Name + Chr(0))
    lpHost = gethostbyname(sHostName)
    If lpHost = 0 Then
        ResolveIPAddress = ""
        MsgBox "Windows Sockets are not responding. Unable to successfully get Host Name."
        SocketsCleanup
        Exit Function
    End If
    CopyMemory HOST, lpHost, Len(HOST)
    CopyMemory dwIPAddr, HOST.hAddrList, 4
    ReDim tmpIPAddr(1 To HOST.hLen)
    CopyMemory tmpIPAddr(1), dwIPAddr, HOST.hLen
    For i = 1 To HOST.hLen
        sIPAddr = sIPAddr & tmpIPAddr(i) & "."
    Next
    ResolveIPAddress = Mid$(sIPAddr, 1, Len(sIPAddr) - 1)
End Function

[tyomitch]

А мой код, который в daemon_saver, работает?
Там, кажется, вызовы обеих функций есть.

[S397]

Будет работать

Код: Выделить всё

Private Const MAX_WSADescription = 256
Private Const MAX_WSASYSStatus = 128

Private Const WS_VERSION_REQD = &H101
Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Private Const MIN_SOCKETS_REQD = 1
Private Const SOCKET_ERROR = -1

Private Declare Function gethostname Lib "WSOCK32.DLL" (ByVal szHost As String, ByVal dwHostLen As Long) As Long
Private Declare Function gethostbyaddr Lib "WSOCK32.DLL" (addr As Long, addrLen As Long, addrType As Long) As Long
Private Declare Function gethostbyname& Lib "WSOCK32.DLL" (ByVal hostname$)
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
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 Type HOSTENT
    hName As Long
    hAliases As Long
    hAddrType As Integer
    hLen As Integer
    hAddrList As Long
End Type
Private Type WSADATA
    wversion As Integer
    wHighVersion As Integer
    szDescription(0 To MAX_WSADescription) As Byte
    szSystemStatus(0 To MAX_WSASYSStatus) As Byte
    wMaxSockets As Long
    wMaxUDPDG As Long
    dwVendorInfo As Long
End Type


Private Sub Main()
    MsgBox ResolveIPAddress("www.microsoft.com")
End Sub

Private Function ResolveIPAddress(ByVal Name As String) As String
Dim sHostName As String * 256
Dim lpHost As Long
Dim HOST As HOSTENT
Dim dwIPAddr As Long
Dim tmpIPAddr() As Byte
Dim i As Integer
Dim sIPAddr As String
    If SocketsInitialize Then
        sHostName = Trim$(Name + Chr(0))
        lpHost = gethostbyname(sHostName)
        If lpHost = 0 Then
            ResolveIPAddress = ""
            MsgBox "Windows Sockets are not responding. Unable to successfully get Host Name."
            Exit Function
        End If
        CopyMemory HOST, lpHost, Len(HOST)
        CopyMemory dwIPAddr, HOST.hAddrList, 4
        ReDim tmpIPAddr(1 To HOST.hLen)
        CopyMemory tmpIPAddr(1), dwIPAddr, HOST.hLen
        For i = 1 To HOST.hLen
            sIPAddr = sIPAddr & tmpIPAddr(i) & "."
        Next
        ResolveIPAddress = Mid$(sIPAddr, 1, Len(sIPAddr) - 1)
    End If
End Function

Private Sub SocketsCleanup()

   Dim X As Long
   
   X = WSACleanup()

   If X <> 0 Then
       MsgBox "Windows Sockets error " & Trim$(Str$(X)) & " occurred in Cleanup.", vbExclamation
   End If
   
End Sub


Private Function SocketsInitialize() As Boolean

    Dim WSAD As WSADATA
    Dim X As Integer
    Dim szLoByte As String
    Dim szHiByte As String
    Dim szBuf As String
   
    X = WSAStartup(WS_VERSION_REQD, WSAD)
   
    If X <> 0 Then

        MsgBox "Windows Sockets for 32 bit Windows " & _
               "environments is not successfully responding."
        Exit Function

    End If
   
    If lobyte(WSAD.wversion) < WS_VERSION_MAJOR Or _
       (lobyte(WSAD.wversion) = WS_VERSION_MAJOR And _
        hibyte(WSAD.wversion) < WS_VERSION_MINOR) Then
       
        szHiByte = Trim$(Str$(hibyte(WSAD.wversion)))
        szLoByte = Trim$(Str$(lobyte(WSAD.wversion)))
        szBuf = "Windows Sockets Version " & szLoByte & "." & szHiByte
        szBuf = szBuf & " is not supported by Windows " & _
                          "Sockets for 32 bit Windows environments."
        MsgBox szBuf, vbExclamation
        Exit Function
       
    End If
   
    If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then

        szBuf = "This application requires a minimum of " & _
                 Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets."
        MsgBox szBuf, vbExclamation
        Exit Function

    End If
   
    SocketsInitialize = True
       
End Function

Private Function lobyte(ByVal wParam As Long) As Integer

    lobyte = wParam And &HFF&

End Function

Private Function hibyte(ByVal wParam As Long) As Integer

    hibyte = wParam \ &H100 And &HFF&

End Function


[Antonariy]

S397
Твой код почти не отличается от моего, но HOST.hLen возвращает далеко не ноль. И даже не 4, как по идее должен. А в качестве адреса микрософта возвращает всякий нонсенс типа 0.0.0.0.0.236.23.0.124.120.29.0.12.237.24.0.0.0.0.0.0.236.23.0

tyomitch, твой вроде работает, только по имени определяет имя И валится при попытке определить что такое microsoft.com без www. Почему так происходит догадываюсь - на одном адресе может быть www, на другом ftp, на третьем nntp.

Значит мне нужно конкретно по ip определить название хоста, не наоборот.

[alibek]

Фрагмент из модуля MSocketSupport (часть CSocket) подойдет?
Там имена ресольвятся.

[Antonariy]

Наверное.

Off:
Блин. Ненавижу читать код, в котором комментариев больше, чем смысла. Особенно умиляют такие пассажи:

Код: Выделить всё


'Increment counter
i = i + 1

'Exits function
Exit Function

Да еще на разных строчках. Да еще отделенные пустой строкой. Это каким идиотом нужно быть, чтобы не понять, что в этих случаях происходит? Большая часть экрана в каментах, аж смысл за ними теряется.

Add: Не очень-то оно. Я не особо разбираюсь в сокетах, чтобы вычленить оттуда то, что нужно.

[alibek]

Тебе нужна функция ResolveHost.
А если конкретно, то этот кусок:

Код: Выделить всё

lngRequestID = WSAAsyncGetHostByName(p_lngWindowHandle, m_lngResolveMessage, strHostAddress, ByVal lngMemoryPointer, MAXGETHOSTSTRUCT)  'Modified: 04-MAR-2002

[Antonariy]

Оказалось, что что код Темыча подходит. Я просто скормил ему ip вместо имени и он выдал имя.

[S397]

Твой код почти не отличается от моего

Нетрудно было догадаться, что я вставил в код твою функцию ResolveIpaddress, ее лишь надо было слегка подправить.
Вот оригинальный вариант

Код: Выделить всё

Private Const MAX_WSADescription = 256
Private Const MAX_WSASYSStatus = 128

Private Const WS_VERSION_REQD = &H101
Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Private Const MIN_SOCKETS_REQD = 1
Private Const SOCKET_ERROR = -1

Private Declare Function gethostname Lib "WSOCK32.DLL" (ByVal szHost As String, ByVal dwHostLen As Long) As Long
Private Declare Function gethostbyaddr Lib "WSOCK32.DLL" (addr As Long, addrLen As Long, addrType As Long) As Long
Private Declare Function gethostbyname& Lib "WSOCK32.DLL" (ByVal hostname$)
Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
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
Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Type HOSTENT
    hName As Long
    hAliases As Long
    hAddrType As Integer
    hLen As Integer
    hAddrList As Long
End Type
Private Type WSADATA
    wversion As Integer
    wHighVersion As Integer
    szDescription(0 To MAX_WSADescription) As Byte
    szSystemStatus(0 To MAX_WSASYSStatus) As Byte
    wMaxSockets As Long
    wMaxUDPDG As Long
    dwVendorInfo As Long
End Type


Private Sub Main()
    Dim oCol As VBA.Collection
    Dim vItem As Variant
    Set oCol = ResolveIpaddress("www.microsoft.com")
    For Each vItem In oCol
        Debug.Print vItem
    Next
End Sub

Public Function ResolveIpaddress(ByVal hostname As String) As Collection
Dim hostent_addr As Long
Dim host As HOSTENT
Dim hostip_addr As Long
Dim temp_ip_address() As Byte
Dim i As Integer
Dim ip_address As String
Dim Count As Integer

    If SocketsInitialize() Then
   
        Set ResolveIpaddress = New Collection
        hostent_addr = gethostbyname(hostname)
       
        If hostent_addr = 0 Then
            SocketsCleanup
            Exit Function
        End If
       
        CopyMemory host, hostent_addr, LenB(host)
        CopyMemory hostip_addr, host.hAddrList, 4
       
       
        Do
            ReDim temp_ip_address(1 To host.hLen)
            CopyMemory temp_ip_address(1), hostip_addr, host.hLen
       
            For i = 1 To host.hLen
                ip_address = ip_address & temp_ip_address(i) & "."
            Next
            ip_address = Mid$(ip_address, 1, Len(ip_address) - 1)
            ResolveIpaddress.Add ip_address
            ip_address = ""
            host.hAddrList = host.hAddrList + LenB(host.hAddrList)
            CopyMemory hostip_addr, host.hAddrList, 4
         Loop While (hostip_addr <> 0)
   
        SocketsCleanup
    End If
End Function

Private Sub SocketsCleanup()

   Dim X As Long
   
   X = WSACleanup()

   If X <> 0 Then
       MsgBox "Windows Sockets error " & Trim$(Str$(X)) & " occurred in Cleanup.", vbExclamation
   End If
   
End Sub


Private Function SocketsInitialize() As Boolean

    Dim WSAD As WSADATA
    Dim X As Integer
    Dim szLoByte As String
    Dim szHiByte As String
    Dim szBuf As String
   
    X = WSAStartup(WS_VERSION_REQD, WSAD)
   
    If X <> 0 Then

        MsgBox "Windows Sockets for 32 bit Windows " & _
               "environments is not successfully responding."
        Exit Function

    End If
   
    If lobyte(WSAD.wversion) < WS_VERSION_MAJOR Or _
       (lobyte(WSAD.wversion) = WS_VERSION_MAJOR And _
        hibyte(WSAD.wversion) < WS_VERSION_MINOR) Then
       
        szHiByte = Trim$(Str$(hibyte(WSAD.wversion)))
        szLoByte = Trim$(Str$(lobyte(WSAD.wversion)))
        szBuf = "Windows Sockets Version " & szLoByte & "." & szHiByte
        szBuf = szBuf & " is not supported by Windows " & _
                          "Sockets for 32 bit Windows environments."
        MsgBox szBuf, vbExclamation
        Exit Function
       
    End If
   
    If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then

        szBuf = "This application requires a minimum of " & _
                 Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets."
        MsgBox szBuf, vbExclamation
        Exit Function

    End If
   
    SocketsInitialize = True
       
End Function

Private Function lobyte(ByVal wParam As Long) As Integer

    lobyte = wParam And &HFF&

End Function

Private Function hibyte(ByVal wParam As Long) As Integer

    hibyte = wParam \ &H100 And &HFF&

End Function