如何通過網絡中的計算機名得到其IP地址。

Question

最好給我提供這個API function.

Answer 1

Private Type HOSTENT
   hName As Long
   hAliases As Long
   hAddrType As Integer
   hLen As Integer
   hAddrList As Long
End TypePrivate Declare Function gethostbyname Lib "wsock32" (ByVal hostname As String) As Long
Private Declare Sub CopyMemoryIP Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Public Function GetIPFromHostName(ByVal sHostName As String) As String    Dim ptrHosent   As Long
    Dim Host        As HOSTENT
    Dim dwIPAddr    As Long
    Dim tmpIPAddr() As Byte
    Dim I           As Integer
    Dim sIPAddr     As String
    
   ptrHosent = gethostbyname(sHostName & vbNullChar)   If ptrHosent <> 0 Then
    
        CopyMemoryIP Host, ptrHosent, Len(Host)
        CopyMemoryIP dwIPAddr, Host.hAddrList, 4
        ReDim tmpIPAddr(1 To Host.hLen)
        CopyMemoryIP tmpIPAddr(1), dwIPAddr, Host.hLen
        For I = 1 To Host.hLen - 1
            sIPAddr = sIPAddr & tmpIPAddr(I) & "."
        Next
        sIPAddr = sIPAddr & tmpIPAddr(I)
        GetIPFromHostName = sIPAddr
        
   End If
   
End Function======================Private Sub Command1_Click()
    MsgBox GetIPFromHostName("www.mvps.org")
End Sub

Answer 2

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 Const WSADescription_Len = 256
Private Const WSASYS_Status_Len = 128Private Type HOSTENT
   hname As Long
   hAliases As Long
   hAddrType As Integer
   hLength As Integer
   hAddrList As Long
End TypePrivate Type WSADATA
   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
Private Declare Function gethostbyaddr Lib "WSOCK32.DLL" (addr As Any, ByVal _
byteslen As Integer, addrtype As Integer) As Long
Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal _
        wVersionRequired&, lpWSAData As WSADATA) As Long
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal _
        hostname$) As Long
Private Declare Sub RtlMoveMemory Lib "KERNEL32" (hpvDest As Any, _
        ByVal hpvSource&, ByVal cbCopy&)Function hibyte(ByVal wParam As Integer)    '获得整数的高位
   hibyte = wParam \ &H100 And &HFF&
End FunctionFunction lobyte(ByVal wParam As Integer)    '获得整数的低位
   lobyte = wParam And &HFF&
End FunctionFunction SocketsInitialize()
   Dim WSAD As WSADATA
   Dim iReturn As Integer
   Dim sLowByte As String, sHighByte As String, sMsg As String
   
   iReturn = WSAStartup(WS_VERSION_REQD, WSAD)
   
   If iReturn <> 0 Then
      MsgBox "Winsock.dll 没有反应."
      End
   End If
   
   If lobyte(WSAD.wversion) < WS_VERSION_MAJOR Or (lobyte(WSAD.wversion) = WS_VERSION_MAJOR And hibyte(WSAD.wversion) < WS_VERSION_MINOR) Then
      sHighByte = Trim$(str$(hibyte(WSAD.wversion)))
      sLowByte = Trim$(str$(lobyte(WSAD.wversion)))
      sMsg = "Windows Sockets版本 " & sLowByte & "." & sHighByte
      sMsg = sMsg & " 不被winsock.dll支持 "
      MsgBox sMsg
      End
   End If
   
   If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
      sMsg = "这个系统需要的最少Sockets数为 "
      sMsg = sMsg & Trim$(str$(MIN_SOCKETS_REQD))
      MsgBox sMsg
      End
   End If
   
End FunctionSub SocketsCleanup()
   Dim lReturn As Long
   
   lReturn = WSACleanup()
   
   If lReturn <> 0 Then
      MsgBox "Socket错误 " & Trim$(str$(lReturn)) & " occurred in Cleanup "
      End
   End If
End Sub
Sub Form_Load()
    '初始化Socket
    SocketsInitialize
End SubPrivate Sub Form_Unload(Cancel As Integer)
    '清除Socket
    SocketsCleanup
End Sub
Private Function getip(name As String) As String
   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
   
   hostent_addr = gethostbyname(name)
   
   If hostent_addr = 0 Then
      getip = ""                     '主机名不能被解释
      Exit Function
   End If
   
   RtlMoveMemory host, hostent_addr, LenB(host)
   RtlMoveMemory hostip_addr, host.hAddrList, 4
   
   ReDim temp_ip_address(1 To host.hLength)
   RtlMoveMemory temp_ip_address(1), hostip_addr, host.hLength
   
   For i = 1 To host.hLength
      ip_address = ip_address & temp_ip_address(i) & "."
   Next
   ip_address = Mid$(ip_address, 1, Len(ip_address) - 1)
   
   getip = ip_addressEnd FunctionPrivate Sub Command1_click()
    Dim str As String
    str = getip(Text1.Text)
    If str = "" Then
        Text2.Text = "主机名不能被解释"
    Else
        Text2.Text = str
    End If
End Sub