142.htm

vb功能实例介绍。详细、很好的实例说明。

<p>vb中从域名得到IP及从IP得到域名 </p>
<p></p>
<p> </p>
<p>Private Const WS_VERSION_REQD = &H101</p>
<p>Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&</p>
<p>Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&</p>
<p>Private Const MIN_SOCKETS_REQD = 1</p>
<p>Private Const SOCKET_ERROR = -1</p>
<p>Private Const WSADescription_Len = 256</p>
<p>Private Const WSASYS_Status_Len = 128</p>
<p></p>
<p>Private Type HOSTENT</p>
<p>   hname As Long</p>
<p>   hAliases As Long</p>
<p>   hAddrType As Integer</p>
<p>   hLength As Integer</p>
<p>   hAddrList As Long</p>
<p>End Type</p>
<p></p>
<p>Private Type WSADATA</p>
<p>   wversion As Integer</p>
<p>   wHighVersion As Integer</p>
<p>   szDescription(0 To WSADescription_Len) As Byte</p>
<p>   szSystemStatus(0 To WSASYS_Status_Len) As Byte</p>
<p>   iMaxSockets As Integer</p>
<p>   iMaxUdpDg As Integer</p>
<p>   lpszVendorInfo As Long</p>
<p>End Type</p>
<p>Private Declare Function gethostbyaddr Lib "WSOCK32.DLL" (addr As Any, ByVal _</p>
<p>byteslen As Integer, addrtype As Integer) As Long</p>
<p>Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long</p>
<p>Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal _</p>
<p>        wVersionRequired&, lpWSAData As WSADATA) As Long</p>
<p>Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long</p>
<p>Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal _</p>
<p>        hostname$) As Long</p>
<p>Private Declare Sub RtlMoveMemory Lib "KERNEL32" (hpvDest As Any, _</p>
<p>        ByVal hpvSource&, ByVal cbCopy&)</p>
<p></p>
<p>Function hibyte(ByVal wParam As Integer)    注释：获得整数的高位</p>
<p>   hibyte = wParam \ &H100 And &HFF&</p>
<p>End Function</p>
<p></p>
<p>Function lobyte(ByVal wParam As Integer)    注释：获得整数的低位</p>
<p>   lobyte = wParam And &HFF&</p>
<p>End Function</p>
<p></p>
<p>Function SocketsInitialize()</p>
<p>   Dim WSAD As WSADATA</p>
<p>   Dim iReturn As Integer</p>
<p>   Dim sLowByte As String, sHighByte As String, sMsg As String</p>
<p>   </p>
<p>   iReturn = WSAStartup(WS_VERSION_REQD, WSAD)</p>
<p>   </p>
<p>   If iReturn <> 0 Then</p>
<p>      MsgBox "Winsock.dll 没有反应."</p>
<p>      End</p>
<p>   End If</p>
<p>   </p>
<p>   If lobyte(WSAD.wversion) < WS_VERSION_MAJOR Or (lobyte(WSAD.wversion) = WS_VERSION_MAJOR And hibyte(WSAD.wversion) < WS_VERSION_MINOR) Then</p>
<p>      sHighByte = Trim$(str$(hibyte(WSAD.wversion)))</p>
<p>      sLowByte = Trim$(str$(lobyte(WSAD.wversion)))</p>
<p>      sMsg = "Windows Sockets版本 " & sLowByte & "." & sHighByte</p>
<p>      sMsg = sMsg & " 不被winsock.dll支持 "</p>
<p>      MsgBox sMsg</p>
<p>      End</p>
<p>   End If</p>
<p>   </p>
<p>   If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then</p>
<p>      sMsg = "这个系统需要的最少Sockets数为 "</p>
<p>      sMsg = sMsg & Trim$(str$(MIN_SOCKETS_REQD))</p>
<p>      MsgBox sMsg</p>
<p>      End</p>
<p>   End If</p>
<p>   </p>
<p>End Function</p>
<p></p>
<p>Sub SocketsCleanup()</p>
<p>   Dim lReturn As Long</p>
<p>   </p>
<p>   lReturn = WSACleanup()</p>
<p>   </p>
<p>   If lReturn <> 0 Then</p>
<p>      MsgBox "Socket错误 " & Trim$(str$(lReturn)) & " occurred in Cleanup "</p>
<p>      End</p>
<p>   End If</p>
<p>End Sub</p>
<p></p>
<p></p>
<p>Sub Form_Load()</p>
<p>    注释：初始化Socket</p>
<p>    SocketsInitialize</p>
<p>End Sub</p>
<p></p>
<p>Private Sub Form_Unload(Cancel As Integer)</p>
<p>    注释：清除Socket</p>
<p>    SocketsCleanup</p>
<p>End Sub</p>
<p>Private Function getip(name As String) As String</p>
<p>   Dim hostent_addr As Long</p>
<p>   Dim host As HOSTENT</p>
<p>   Dim hostip_addr As Long</p>
<p>   Dim temp_ip_address() As Byte</p>
<p>   Dim i As Integer</p>
<p>   Dim ip_address As String</p>
<p>   </p>
<p>   hostent_addr = gethostbyname(name)</p>
<p>   </p>
<p>   If hostent_addr = 0 Then</p>
<p>      getip = ""                     注释：主机名不能被解释</p>
<p>      Exit Function</p>
<p>   End If</p>
<p>   </p>
<p>   RtlMoveMemory host, hostent_addr, LenB(host)</p>
<p>   RtlMoveMemory hostip_addr, host.hAddrList, 4</p>
<p>   </p>
<p>   ReDim temp_ip_address(1 To host.hLength)</p>
<p>   RtlMoveMemory temp_ip_address(1), hostip_addr, host.hLength</p>
<p>   </p>
<p>   For i = 1 To host.hLength</p>
<p>      ip_address = ip_address & temp_ip_address(i) & "."</p>
<p>   Next</p>
<p>   ip_address = Mid$(ip_address, 1, Len(ip_address) - 1)</p>
<p>   </p>
<p>   getip = ip_address</p>
<p></p>
<p>End Function</p>
<p></p>
<p>Private Sub Command1_click()</p>
<p>    Dim str As String</p>
<p>    str = getip(Text1.Text)</p>
<p>    If str = "" Then</p>
<p>        Text2.Text = "主机名不能被解释"</p>
<p>    Else</p>
<p>        Text2.Text = str</p>
<p>    End If</p>
<p>End Sub</p>
<p>Private Function getname(addrstr As String) As String</p>
<p>    Dim hostent_addr As Long</p>
<p>    Dim host As HOSTENT</p>
<p>    Dim addr(0 To 50) As Byte</p>
<p>    Dim addrs As String</p>
<p>    Dim hname(1 To 50) As Byte</p>
<p>    Dim str As String</p>
<p>    Dim i As Integer, j As Integer</p>
<p>    Dim temp_int As Integer</p>
<p>    Dim byt As Byte</p>
<p>    str = Trim$(addrstr)</p>
<p>    i = 0</p>
<p>    j = 0</p>
<p>    Do</p>
<p>        temp_int = 0</p>
<p>        i = i + 1</p>
<p>        Do While Mid$(str, i, 1) >= "0" And Mid$(str, i, 1) <= "9" And i <= Len(str)</p>
<p>            temp_int = temp_int * 10 + Mid$(str, i, 1)</p>
<p>            i = i + 1</p>
<p>        Loop</p>
<p>        If temp_int <= 255 Then</p>
<p>            addr(j) = temp_int</p>
<p>            j = j + 1</p>
<p>        End If</p>
<p>    </p>
<p>    Loop Until Mid$(str, i, 1) <> "." Or i > Len(str) Or temp_int > 255</p>
<p>    If temp_int > 255 Then</p>
<p>        getname = "地址非法"</p>
<p>        Exit Function</p>
<p>    End If</p>
<p>    hostent_addr = gethostbyaddr(addr(0), j, 2)</p>
<p>    If hostent_addr = 0 Then</p>
<p>        getname = "此地址无法解析"</p>
<p>        Exit Function</p>
<p>    End If</p>
<p>    RtlMoveMemory host, hostent_addr, LenB(host)</p>
<p>    RtlMoveMemory hname(1), host.hname, 50</p>
<p>    j = 51</p>
<p>    For i = 1 To 50</p>
<p>        If hname(i) = 0 Then</p>
<p>            j = i</p>
<p>        End If</p>
<p>        If i >= j Then</p>
<p>            hname(i) = 32</p>
<p>        End If</p>
<p>    Next i</p>
<p>    getname = Trim$(StrConv(hname, vbUnicode))</p>
<p>End Function</p>
<p>Private Sub Command2_Click()</p>
<p>    Dim name As String</p>
<p>    name = getname(Text2.Text)</p>
<p>    If name = "" Then</p>
<p>        name = "此地址没有域名"</p>
<p>    End If</p>
<p>    Text1.Text = name</p>
<p>End Sub</p>
<p> </p>