vb中从域名得到IP及从IP得到域名

'vb中从域名得到IP及从IP得到域名      

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 = 128

PrivateType HOSTENT
   hname As LonghAliases As LonghAddrType As IntegerhLength As IntegerhAddrList As Long
EndType

PrivateType WSADATA
   wversion As IntegerwHighVersion As IntegerszDescription(0 To WSADescription_Len) As ByteszSystemStatus(0 To WSASYS_Status_Len) As ByteiMaxSockets As IntegeriMaxUdpDg As IntegerlpszVendorInfo As Long
EndType
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 AsAny, _
        ByVal hpvSource&, ByVal cbCopy&)

Function hibyte(ByVal wParam As Integer)    '获得整数的高位
   hibyte = wParam  &H100 And &HFF&
End Function

Function lobyte(ByVal wParam As Integer)    '获得整数的低位
   lobyte = wParam And &HFF&
End Function

FunctionSocketsInitialize()
   Dim WSAD AsWSADATA
   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) ThensHighByte = Trim$(str$(hibyte(WSAD.wversion)))
      sLowByte = Trim$(str$(lobyte(WSAD.wversion)))
      sMsg = "Windows Sockets版本 " & sLowByte & "." &sHighByte
      sMsg = sMsg & "不被winsock.dll支持 "
      MsgBoxsMsg
      End
   End If
   
   If WSAD.iMaxSockets < MIN_SOCKETS_REQD ThensMsg = "这个系统需要的最少Sockets数为 "sMsg = sMsg & Trim$(str$(MIN_SOCKETS_REQD))
      MsgBoxsMsg
      End
   End If
   
End Function

SubSocketsCleanup()
   Dim lReturn As Long
   lReturn =WSACleanup()
   
   If lReturn <> 0 Then
      MsgBox "Socket错误 " & Trim$(str$(lReturn)) & "occurred in Cleanup "
      End
   End If
End Sub


SubForm_Load()
    '初始化Socket
SocketsInitialize
End Sub

Private 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 AsHOSTENT
   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 Thengetip = ""                     '主机名不能被解释
      Exit Function
   End If
   RtlMoveMemory host, hostent_addr, LenB(host)
   RtlMoveMemory hostip_addr, host.hAddrList, 4
   
   ReDim temp_ip_address(1 Tohost.hLength)
   RtlMoveMemory temp_ip_address(1), hostip_addr, host.hLength
   
   For i = 1 Tohost.hLength
      ip_address = ip_address & temp_ip_address(i) & "."
   Nextip_address = Mid$(ip_address, 1, Len(ip_address) - 1)
   
   getip =ip_address

End Function

Private SubCommand1_click()
    Dim str As String
    str =getip(Text1.Text)
    If str = "" ThenText2.Text = "主机名不能被解释"
    ElseText2.Text = str
    End If
End Sub
Private Function getname(addrstr As String) As String
    Dim hostent_addr As Long
    Dim host AsHOSTENT
    Dim addr(0 To 50) As Byte
    Dim addrs As String
    Dim hname(1 To 50) As Byte
    Dim str As String
    Dim i As Integer, j As Integer
    Dim temp_int As Integer
    Dim byt As Byte
    str = Trim$(addrstr)
    i = 0j = 0
    Dotemp_int = 0i = i + 1
        Do While Mid$(str, i, 1) >= "0" And Mid$(str, i, 1) <= "9" And i <= Len(str)
            temp_int = temp_int * 10 + Mid$(str, i, 1)
            i = i + 1
        Loop
        If temp_int <= 255 Thenaddr(j) =temp_int
            j = j + 1
        End If
    
    Loop Until Mid$(str, i, 1) <> "." Or i > Len(str) Or temp_int > 255
    If temp_int > 255 Thengetname = "地址非法"
        Exit Function
    End Ifhostent_addr = gethostbyaddr(addr(0), j, 2)
    If hostent_addr = 0 Thengetname = "此地址无法解析"
        Exit Function
    End IfRtlMoveMemory host, hostent_addr, LenB(host)
    RtlMoveMemory hname(1), host.hname, 50j = 51
    For i = 1 To 50
        If hname(i) = 0 Thenj =i
        End If
        If i >= j Thenhname(i) = 32
        End If
    Nexti
    getname = Trim$(StrConv(hname, vbUnicode))
End Function
Private SubCommand2_Click()
    Dim name As Stringname =getname(Text2.Text)
    If name = "" Thenname = "此地址没有域名"
    End IfText1.Text =name
End Sub