求源代码！

我有一个类代码，你看看怎样！
Option Explicit'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
'ａｐｉ函数
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 TypePrivate 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&)
'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
'本类使用的私有变量
Private nIPAddress As String
Private nDomainName As String
Private nClsError As String
'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-Private Function hibyte(ByVal wParam As Integer) As Byte    '获得整数的高位
   hibyte = wParam \ &H100 And &HFF&
End FunctionPrivate Function lobyte(ByVal wParam As Integer) As Byte    '获得整数的低位
   lobyte = wParam And &HFF&
End Function'设置ip地址的属性
Public Property Let IPAddress(sIP As String)
    nIPAddress = sIP
End Property'设置域名的属性
Public Property Let DomainName(sDname As String)
    nDomainName = sDname
End Property'得到IP地址的属性
Public Property Get IPAddress() As String
    nIPAddress = GetIP(nDomainName)
    IPAddress = nIPAddress
End Property'得到IP地址的属性
Public Property Get DomainName() As String
    nDomainName = GetName(nIPAddress)
    DomainName = nDomainName
End Property'得到错误内容
Public Property Get LastError() As String
    LastError = nClsError
End Property'初始化SOCKET
Private Function SocketsInitialize() As Boolean
   Dim WSAD As WSADATA
   Dim iReturn As Integer
   Dim sLowByte As String, sHighByte As String

   iReturn = WSAStartup(WS_VERSION_REQD, WSAD)

   If iReturn <> 0 Then
      SocketsInitialize = False
      nClsError = "Winsock.dll 没有反应."
      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
      sHighByte = Trim$(str$(hibyte(WSAD.wversion)))
      sLowByte = Trim$(str$(lobyte(WSAD.wversion)))
      nClsError = "Windows Sockets版本 " & sLowByte & "." & sHighByte
      nClsError = nClsError & " 不被winsock.dll支持 "
      SocketsInitialize = False
      Exit Function
   End If

   If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
      nClsError = "这个系统需要的最少Sockets数为 "
      nClsError = nClsError & Trim$(str$(MIN_SOCKETS_REQD))
      SocketsInitialize = False
      Exit Function
   End If

   SocketsInitialize = True

End Function'清除socket
Private Function SocketsCleanup() As Boolean
   Dim lReturn As Long
   lReturn = WSACleanup()
   If lReturn <> 0 Then
      SocketsCleanup = False
      nClsError = "Socket错误 " & Trim$(str$(lReturn)) & " occurred in Cleanup "
      Exit Function
   End If
   SocketsCleanup = True
End Function'通过域名得到IP地址
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 Function'通过ip地址得到域名
Private 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
        DoEvents
        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'类初始化
Private Sub Class_Initialize()
    If SocketsInitialize = False Then
        MsgBox nClsError, 48, "类初始化错误！"
    End If
End Sub'类终止
Private Sub Class_Terminate()
    If SocketsCleanup = False Then
        MsgBox nClsError, 48, "类终止错误！"
    End If
End Sub

解决方案 »