csocket.cls

VB做滴邮件收发系统,喜欢的朋友可以下载看看学习参考哈

    mvarState = sckResolvingHost

    '
    'Maybe you expect to see the connect Winsock API function
    'here, but instead the MScoketSupport.ResolveHost one is
    'called. The connect function does its work in another place
    'of this class - in the PostGetHostEvent procedure, since we
    'need an address of the host in order to establish a connection.
    '
    'The ResolveHost function, that can be found in the MSocketSupport
    'module, will call either the WSAAsyncGetHostByName or WSAAsyncGetHostByAddress
    'depending on what is passed to it with the first argument. Anyway, those
    'functions are asynchronous ones, so code in this class will be executing
    'after the call to the PostGetHostEvent procedure from the WindowProc function
    'in the MSupportSocket.
    '
    'Also, as you can see, the second argument is a pointer to the object, that is
    'this instance of the CSocket class. We need this because the MSocketSupport
    'module is supposed to serve several sockets, not a single one. So the
    'MSocketSupport module should know which CSocket's instance to return info to.
    '
    m_lngRequestID = 0
    m_varInternalState = istConnecting
    m_lngRequestID = MSocketSupport.ResolveHost(m_strRemoteHost, ObjPtr(Me))
    '
EXIT_LABEL:
    '

Exit Sub

    '
Connect_Err_Handler:
    '
    Err.Raise Err.Number, "CSocket.CSocket.Connect", Err.Description
    '
    GoTo EXIT_LABEL
    '

End Sub

Public Sub CloseSocket()
Attribute CloseSocket.VB_Description = "Close current connection"

  '

  Dim lngRetValue As Long 'value returned by the shutdown Winsock API function

    '
    On Error GoTo Close_Err_Handler
    '
    'Why do we need to run the code that should not be running?
    If m_lngSocketHandle = INVALID_SOCKET Then Exit Sub ':(燛xpand Structure or consider reversing Condition
    '
    If Not mvarState = sckConnected Then
        '
        'If the socket is not connected we can just close it
        Call DestroySocket
        mvarState = sckClosed

        '
      Else 'NOT NOT...
        '
        'If the socket is connected, it's another story.
        'In order to be sure that no data will be lost the
        'graceful shutdown of the socket should be performed.
        '
        mvarState = sckClosing

        '
        'Call the shutdown Winsock API function in order to
        'close the connection. That doesn't mean that the
        'connection will be closed after the call of the
        'shutdown function. Connection will be closed from
        'the PostSocketEvent subroutine when the FD_CLOSE
        'message will be received.
        '
        'For people who know what the FIN segment in the
        'TCP header is - this function sends an empty packet
        'with the FIN bit turned on.
        '
        lngRetValue = shutdown(m_lngSocketHandle, SD_SEND)
        '

        '
        If lngRetValue = SOCKET_ERROR Then
            Err.Raise Err.LastDllError, "CSocket.CloseSocket", GetErrorDescription(Err.LastDllError)
        End If
        '
    End If

EXIT_LABEL:
    '

Exit Sub

    '
Close_Err_Handler:
    '
    If Err.Number <> 10038 Then
        'Err.Raise Err.Number, "CSocket.Close", Err.Description
    End If
    '
    GoTo EXIT_LABEL
    '

End Sub

Public Sub Bind(Optional lngLocalPort As Long, Optional strLocalIP As String)
Attribute Bind.VB_Description = "Binds socket to specific port and adapter"

  '

  Dim lngRetValue     As Long         'value returned by the bind Winsock API function
  Dim udtLocalAddr    As sockaddr_in  'local socket address to bind to - used by the

    '                                    bind Winsock API function
  Dim lngAddress      As Long         '32-bit host address - value returned by':(燤ove line to top of current Sub
    '                                    the inet_addr Winsock API function
    '
    On Error GoTo Bind_Err_Handler
    '
    'If no socket has been created before, try to create a new one
    If Not SocketExists Then Exit Sub ':(燛xpand Structure or consider reversing Condition
    '
    'If the arguments of this function are not missing, they
    'overwrites values of the RemoteHost and RemotePort properties.
    '
    If Len(strLocalIP) > 0 Then
        m_strLocalIP = strLocalIP
    End If
    '
    If lngLocalPort > 0 Then
        m_lngLocalPort = lngLocalPort
    End If
    '
    If Len(m_strLocalIP) > 0 Then
        '
        'If the local IP is known, get the address
        'from it with the inet_addr Winsock API function.
        lngAddress = inet_addr(m_strLocalIP)
        '
      Else 'NOT LEN(M_STRLOCALIP)...
        '
        'If the IP is unknown, assign the default interface's IP.
        'Actually, this line is useless in Visual Basic code,
        'as INADDR_ANY = 0 (IP = 0.0.0.0).
        lngAddress = INADDR_ANY
        '
    End If
    '
    If lngAddress = SOCKET_ERROR Then
        '
        'Bad address - go away
        Err.Raise Err.LastDllError, "CSocket.Bind", GetErrorDescription(Err.LastDllError)
        Exit Sub '>---> Bottom
        '
    End If
    '
    'Prepare the udtLocalAddr UDT that is a socket address structure.
    With udtLocalAddr
        '
        .sin_addr = lngAddress  'host address (32-bits value)
        .sin_family = AF_INET   'address family
        .sin_port = htons(LongToUnsigned(m_lngLocalPort))   'port number in the network byte order
        '
    End With 'UDTLOCALADDR
    '
    'Call the bind Winsock API function in order to assign local address for the socket
    lngRetValue = api_bind(m_lngSocketHandle, udtLocalAddr, Len(udtLocalAddr))
    '
    If lngRetValue = SOCKET_ERROR Then
        '
        Err.Raise Err.LastDllError, "CSocket.Bind", GetErrorDescription(Err.LastDllError)
        '
      Else 'NOT LNGRETVALUE...
        '
        m_blnSocketIsBound = True   'Added: 10-MAR-2002
        '
    End If
    '
EXIT_LABEL:
    '

Exit Sub

    '
Bind_Err_Handler:
    '
    Err.Raise Err.Number, "CSocket.Bind", Err.Description
    '
    GoTo EXIT_LABEL
    '

End Sub

Public Sub Accept(requestID As Long)
Attribute Accept.VB_Description = "Accept an incoming connection request"

  '
  'The requestID argument is provided with the ConnectRequest
  'event of another instance of the CSocket class. Actually,
  'this argument is a handle of the socket already created
  'calling the Accept Winsock API function by that (another)
  'instance of the CSocket class.
  '

  Dim lngRetValue As Long         'value returned by the getsockname, getpeername, and

    '                                getsockopt Winsock API functions
  Dim lngBuffer   As Long         'the buffer to pass with the getsockopt Winsock API function':(燤ove line to top of current Sub
  Dim udtSockAddr As sockaddr_in  'socket address - used by the getsockname and getpeername':(燤ove line to top of current Sub
    '                                Winsock API functions
  Dim udtHostEnt  As HostEnt      'structure to hold the host info - returned by the':(燤ove line to top of current Sub
    '                                getsockname and getpeername Winsock API functions
    '
    On Error GoTo Accept_Err_Handler
    '
    'What we need to do in the body of this subroutine is to
    'initialize the properties of the class that we can find
    'values for. Also we need to register the socket with
    'the RegisterSocket function from MSocketSupport module.
    '
    'Assign the socket handle
    m_lngSocketHandle = requestID
    '
    'Retrieve the connection end-points to initialize
    'the following properties of the CSocket class:
    'LocalPort, LocalIP, LocalHostName
    'RemotePort, RemoteHostIP, RemoteHost
    '
    'Local end point
    '
    lngRetValue = getsockname(m_lngSocketHandle, udtSockAddr, Len(udtSockAddr))
    '
    If lngRetValue = 0 Then
        '
        'LocalPort property
        m_lngLocalPort = IntegerToUnsigned(ntohs(udtSockAddr.sin_port))
        'LocalIP property
        m_strLocalIP = StringFromPointer(inet_ntoa(udtSockAddr.sin_addr))
        'LocalHostName property
        lngRetValue = gethostbyaddr(udtSockAddr.sin_addr, 4&, AF_INET)
        CopyMemory udtHostEnt, ByVal lngRetValue, Len(udtHostEnt)
        m_strLocalHostName = StringFromPointer(udtHostEnt.hName)
        '
    End If
    '
    'Remote end point
    '
    lngRetValue = getpeername(m_lngSocketHandle, udtSockAddr, Len(udtSockAddr))
    '
    If lngRetValue = 0 Then
        '
        'RemotePort property
        m_lngRemotePort = IntegerToUnsigned(ntohs(udtSockAddr.sin_port))
        'RemoteHostIP property
        m_strRemoteHostIP = StringFromPointer(inet_ntoa(udtSockAddr.sin_addr))
        'RemoteHost property
        lngRetValue = gethostbyaddr(udtSockAddr.sin_addr, 4&, AF_INET)
        CopyMemory udtHostEnt, ByVal lngRetValue, Len(udtHostEnt)
        m_strRemoteHost = StringFromPointer(udtHostEnt.hName)
        '
    End If
    '
    'Retrieve the socket type to initialize the Protocol property
    lngRetValue = getsockopt(m_lngSocketHandle, SOL_SOCKET, SO_TYPE, lngBuffer, LenB(lngBuffer))
    '
    If lngRetValue <> SOCKET_ERROR Then
        '
        If lngBuffer = SOCK_STREAM Then
            mvarProtocol = sckTCPProtocol
          Else 'NOT LNGBUFFER...
            mvarProtocol = sckUDPProtocol
        End If
        '
    End If
    '
    'Get default size of the Winsock's buffers.
    Call GetWinsockBuffers  'Added: 10-MAR-2002
    '
    If MSocketSupport.RegisterSocket(m_lngSocketHandle, ObjPtr(Me)) Then
        '
        'Change the State property value
        mvarState = sckConnected

        '
    End If
    '
EXIT_LABEL:
    '

Exit Sub

    '
Accept_Err_Handler:
    '
    Err.Raise Err.Number, "CSocket.Accept", Err.Description
    '
    GoTo EXIT_LABEL
    '

End Sub

Public Property Get State() As StateConstants

    State = mvarState

End Property

Public Property Get SocketHandle() As Long
Attribute SocketHandle.VB_Description = " Returns the socket handle"

    SocketHandle = m_lngSocketHandle

End Property

Public Property Get RemotePort() As Long
Attribute RemotePort.VB_Description = "Returns/Sets the port to be connected to on the remote computer"

    RemotePort = m_lngRemotePort

End Property

Public Property Let RemotePort(NewValue As Long)

    m_lngRemotePort = NewValue

End Property

Public Property Get RemoteHostIP() As String
Attribute RemoteHostIP.VB_Description = "Returns the remote host IP address"

    RemoteHostIP = m_strRemoteHostIP

End Property

Public Property Get RemoteHost() As String
Attribute RemoteHost.VB_Description = "Returns/Sets the name used to identify the remote computer"

    RemoteHost = m_strRemoteHost

End Property

Public Property Let RemoteHost(NewValue As String)

    m_strRemoteHostIP = ""
    m_strRemoteHost = NewValue

End Property

Public Property Get protocol() As ProtocolConstants
Attribute protocol.VB_Description = "Returns/Sets the socket protocol"

    protocol = mvarProtocol

End Property

Public Property Let protocol(NewValue As ProtocolConstants)

  '

    If m_lngSocketHandle = INVALID_SOCKET Then  'Modified: 10-MAR-2002
        mvarProtocol = NewValue
    End If
    '

End Property

Public Property Get LocalPort() As Long
Attribute LocalPort.VB_Description = "Returns/Sets the port used on the local computer"

    LocalPort = m_lngLocalPort

End Property

Public Property Let LocalPort(NewValue As Long)

    m_lngLocalPort = NewValue

End Property

Public Property Get LocalIP() As String
Attribute LocalIP.VB_Description = "Returns the local machine IP address"

    LocalIP = m_strLocalIP

End Property

Public Property Get LocalHostName() As String
Attribute LocalHostName.VB_Description = "Returns the local machine name"

    LocalHostName = m_strLocalHostName

End Property

Public Property Get BytesReceived() As Long
Attribute BytesReceived.VB_Description = "Returns the number of bytes received on this connection"

    BytesReceived = m_lngBytesReceived

End Property

Private Sub Class_Initialize()

  '
  'Socket's handle default value

    m_lngSocketHandle = INVALID_SOCKET
    'Initialize the Winsock service
    m_lngMaxMsgSize = MSocketSupport.InitWinsockService