ip.bas

文件传送

Attribute VB_Name = "IP"

'此模块用来解析域名IP
'用法为:
'getip(域名)
'返回值为一标准IP地址格式的String变量
'getname这个函数用来取得IP对应的域名.但是没有什么用的.


Public Const WS_VERSION_REQD = &H101
Public Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Public Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Public Const MIN_SOCKETS_REQD = 1
Public Const SOCKET_ERROR = -1
Public Const WSADescription_Len = 256
Public Const WSASYS_Status_Len = 128

Public Type HOSTENT
   hname As Long
   hAliases As Long
   hAddrType As Integer
   hLength As Integer
   hAddrList As Long
End Type

Public 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
Public Declare Function gethostbyaddr Lib "WSOCK32.DLL" (addr As Any, ByVal _
byteslen As Integer, addrtype As Integer) As Long
Public Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
Public Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal _
        wVersionRequired&, lpWSAData As WSADATA) As Long
Public Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Public Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal _
        hostname$) As Long
Public Declare Sub RtlMoveMemory Lib "KERNEL32" (hpvDest As Any, _
        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

Function 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 Function

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

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_address

End Function

Function getname(addrstr As String) As String
    Dim hostent_addr As Long
    Dim host As HOSTENT
    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 = 0
    j = 0
    Do
        temp_int = 0
        i = 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 Then
            addr(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 Then
        getname = "地址非法"
        Exit Function
    End If
    hostent_addr = gethostbyaddr(addr(0), j, 2)
    If hostent_addr = 0 Then
        getname = "此地址无法解析"
        Exit Function
    End If
    RtlMoveMemory host, hostent_addr, LenB(host)
    RtlMoveMemory hname(1), host.hname, 50
    j = 51
    For i = 1 To 50
        If hname(i) = 0 Then
            j = i
        End If
        If i >= j Then
            hname(i) = 32
        End If
    Next i
    getname = Trim$(StrConv(hname, vbUnicode))
End Function