Email服务器

开发平台：
Visual Basic

CSocket.cls：源码内容
							VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CSocket"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'
'The CSocket protocol's constants as for
'the MS Winsock Control interface
Public Enum ProtocolConstants
    sckTCPProtocol = 0
    sckUDPProtocol = 1
End Enum
'
'The CSocket error's constants as for
'the MS Winsock Control interface
Public Enum ErrorConstants
    sckAddressInUse = 10048
    sckAddressNotAvailable = 10049
    sckAlreadyComplete = 10037
    sckAlreadyConnected = 10056
    sckBadState = 40006
    sckConnectAborted = 10053
    sckConnectionRefused = 10061
    sckConnectionReset = 10054
    sckGetNotSupported = 394
    sckHostNotFound = 11001
    sckHostNotFoundTryAgain = 11002
    sckInProgress = 10036
    sckInvalidArg = 40014
    sckInvalidArgument = 10014
    sckInvalidOp = 40020
    sckInvalidPropertyValue = 380
    sckMsgTooBig = 10040
    sckNetReset = 10052
    sckNetworkSubsystemFailed = 10050
    sckNetworkUnreachable = 10051
    sckNoBufferSpace = 10055
    sckNoData = 11004
    sckNonRecoverableError = 11003
    sckNotConnected = 10057
    sckNotInitialized = 10093
    sckNotSocket = 10038
    sckOpCanceled = 10004
    sckOutOfMemory = 7
    sckOutOfRange = 40021
    sckPortNotSupported = 10043
    sckSetNotSupported = 383
    sckSocketShutdown = 10058
    sckSuccess = 40017
    sckTimedout = 10060
    sckUnsupported = 40018
    sckWouldBlock = 10035
    sckWrongProtocol = 40026
End Enum
'
'The CSocket state's constants as for
'the MS Winsock Control interface
Public Enum StateConstants
    sckClosed = 0
    sckOpen
    sckListening
    sckConnectionPending
    sckResolvingHost
    sckHostResolved
    sckConnecting
    sckConnected
    sckClosing
    sckError
End Enum
'
'In order to resolve a host name the MSocketSupport.ResolveHost
'function can be called from the Connect and SendData methods
'of this class. The callback acceptor for that routine is the
'PostGetHostEvent procedure. This procedure determines what to
'do next with the received host's address checking a value of
'the m_varInternalState variable.
Private Enum InternalStateConstants
    istConnecting
    istSendingDatagram
End Enum
'
Private m_varInternalState As InternalStateConstants
'
'Local (module level) variables to hold values of the
'properties of this (CSocket) class.
Private mvarProtocol        As ProtocolConstants
Private mvarState           As StateConstants
Private m_lngBytesReceived  As Long
Private m_strLocalHostName  As String
Private m_strLocalIP        As String
Private m_lngLocalPort      As Long
Private m_strRemoteHost     As String
Private m_strRemoteHostIP   As String
Private m_lngRemotePort     As Long
Private m_lngSocketHandle   As Long
'
'Resolving host names is performed in an asynchronous mode,
'the m_lngRequestID variable just holds the value returned
'by the ResolveHost function from the MSocketSupport module.
Private m_lngRequestID      As Long
'
'Internal (for this class) buffers. They are the VB Strings.
'Don't trust that guy who told that the VB String data type
'cannot properly deal with binary data. Actually, it can, and
'moreover you have a lot of means to deal with that data -
'the VB string functions (such as Left, Mid, InStr and so on).
'If you need to get a byte array from a string, just call the
'StrConv function:
'
'byteArray() = StrConv(strBuffer, vbFromUnicode)
'
Private m_strSendBuffer     As String 'The internal buffer for outgoing data
Private m_strRecvBuffer     As String 'The internal buffer for incoming data
'
'Lenght of the Winsock buffers. By default = 8192 bytes for TCP sockets.
'These values are initialized in the SocketExists function.
'Now, I really don't know why I was in need to get these values.
Private m_lngSendBufferLen  As Long
Private m_lngRecvBufferLen  As Long
'
'Maximum size of a datagram that can be sent through
'a message-oriented (UDP) socket. This value is returned
'by the InitWinsock function from the MSocketSupport module.
Private m_lngMaxMsgSize     As Long
'
'This flag variable indicates that the socket is bound to
'some local socket address
Private m_blnSocketIsBound  As Boolean  'Added: 10-MAR-2002
'
'These are those MS Winsock's events.
'Pay attention that the "On" prefix is added.
Public Event OnClose()
Attribute OnClose.VB_Description = "Occurs when the connection has been closed"
Public Event OnConnect()
Attribute OnConnect.VB_Description = "Occurs connect operation is completed"
Public Event OnConnectionRequest(ByVal requestID As Long)
Public Event OnDataArrival(ByVal bytesTotal As Long)
Public Event OnError(ByVal Number As Integer, Description As String, ByVal sCode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
Public Event OnSendComplete()
Public Event OnSendProgress(ByVal bytesSent As Long, ByVal bytesRemaining As Long)
Public Sub SendData(varData As Variant)
Attribute SendData.VB_Description = "Send data to remote computer"
  '
  'data to send - will be built from the varData argument
  Dim arrData()       As Byte
    'value returned by the send(sendto) Winsock API function
  Dim lngRetValue     As Long ':(燤ove line to top of current Sub
    'length of the data to send - needed to call the send(sendto) Winsock API function
  Dim lngBufferLength As Long ':(燤ove line to top of current Sub
    'this strucure just contains address of the remote socket to send data to;
    'only for UDP sockets when the sendto Winsock API function is used
  Dim udtSockAddr     As sockaddr_in ':(燤ove line to top of current Sub
    '
    On Error GoTo SendData_Err_Handler
    '
    'If a connection-oriented (TCP) socket was not created or connected to the
    'remote host before calling the SendData method, the MS Winsock Control
    'raises the sckBadState error.
    If mvarProtocol = sckTCPProtocol Then
        '
        If m_lngSocketHandle = INVALID_SOCKET Then
            Err.Raise sckBadState, "CSocket.SendData", _
                      "Wrong protocol or connection state for the requested transaction or request."
            Exit Sub '>---> Bottom
        End If
        '
      Else 'NOT MVARPROTOCOL...
        '
        'If the socket is a message-oriented one (UDP), this is OK to create
        'it with the call of the SendData method. The SocketExists function
        'creates a new socket.
        If Not SocketExists Then Exit Sub ':(燛xpand Structure or consider reversing Condition
        '
    End If
    '
    Select Case varType(varData)
      Case vbArray + vbByte
        'Modified 28-MAY-2002. Thanks to Michael Freidgeim
        '--------------------------------
        'Dim strArray As String
        'strArray = CStr(varData)
        arrData() = varData
        '--------------------------------
      Case vbBoolean
  Dim blnData As Boolean ':(燤ove line to top of current Sub
        blnData = CBool(varData)
        ReDim arrData(LenB(blnData) - 1)
        CopyMemory arrData(0), blnData, LenB(blnData)
      Case vbByte
  Dim bytData As Byte ':(燤ove line to top of current Sub
        bytData = CByte(varData)
        ReDim arrData(LenB(bytData) - 1)
        CopyMemory arrData(0), bytData, LenB(bytData)
      Case vbCurrency
  Dim curData As Currency ':(燤ove line to top of current Sub
        curData = CCur(varData)
        ReDim arrData(LenB(curData) - 1)
        CopyMemory arrData(0), curData, LenB(curData)
      Case vbDate
  Dim datData As Date ':(燤ove line to top of current Sub
        datData = CDate(varData)
        ReDim arrData(LenB(datData) - 1)
        CopyMemory arrData(0), datData, LenB(datData)
      Case vbDouble
  Dim dblData As Double ':(燤ove line to top of current Sub
        dblData = CDbl(varData)
        ReDim arrData(LenB(dblData) - 1)
        CopyMemory arrData(0), dblData, LenB(dblData)
      Case vbInteger
  Dim intData As Integer ':(燤ove line to top of current Sub
        intData = CInt(varData)
        ReDim arrData(LenB(intData) - 1)
        CopyMemory arrData(0), intData, LenB(intData)
      Case vbLong
  Dim lngData As Long ':(燤ove line to top of current Sub
        lngData = CLng(varData)
        ReDim arrData(LenB(lngData) - 1)
        CopyMemory arrData(0), lngData, LenB(lngData)
      Case vbSingle
  Dim sngData As Single ':(燤ove line to top of current Sub
        sngData = CSng(varData)
        ReDim arrData(LenB(sngData) - 1)
        CopyMemory arrData(0), sngData, LenB(sngData)
      Case vbString
  Dim strData As String ':(燤ove line to top of current Sub
        strData = CStr(varData)
        ReDim arrData(Len(strData) - 1)
        arrData() = StrConv(strData, vbFromUnicode)
      Case Else
        '
        'Unknown data type
        '
    End Select
    '
    'Store all the data to send in the module level
    'variable m_strSendBuffer.
    m_strSendBuffer = StrConv(arrData(), vbUnicode)
    '
    'Call the SendBufferedData subroutine in order to send the data.
    'The SendBufferedData sub is just a common procedure that is
    'called from different places in this class.
    'Nothing special - just the code reuse.
    Call SendBufferedData
    '
EXIT_LABEL:
    '
Exit Sub
    '
SendData_Err_Handler:
    '
    If Err.LastDllError = WSAENOTSOCK Then
        Err.Raise sckBadState, "CSocket.SendData", "Wrong protocol or connection state for the requested transaction or request."
      Else 'NOT ERR.LASTDLLERROR...
        Err.Raise Err.Number, "CSocket.SendData", Err.Description
    End If
    '
    GoTo EXIT_LABEL
    '
End Sub
Public Sub PeekData(varData As Variant, Optional varType As Variant, Optional maxLen As Variant)
Attribute PeekData.VB_Description = "Look at incoming data without removing it from the buffer"
  '
  Dim lngBytesReceived As Long    'value returned by the RecvData function
    '
    On Error GoTo PeekData_Err_Handler
    '
    'The RecvData is a universal subroutine that can either to retrieve or peek
    'data from the Winsock buffer. If a value of the second argument (blnPeek As Boolean)
    'of the RecvData subroutine is True, it will be just peeking.
    lngBytesReceived = RecvData(varData, True, IIf(IsMissing(varType), Empty, varType), _
                       IIf(IsMissing(maxLen), Empty, maxLen))
    '
EXIT_LABEL:
    '
Exit Sub
    '
PeekData_Err_Handler:
    '
    Err.Raise Err.Number, "CSocket.PeekData", Err.Description
    '
    GoTo EXIT_LABEL
    '
End Sub
Public Sub Listen()
Attribute Listen.VB_Description = "Listen for incoming connection requests"
  '
  Dim lngRetValue As Long 'value returned by the listen Winsock API function
    '
    On Error GoTo Listen_Err_Handler
    '
    'SocketExists is not a variable. It is a function that can
    'create a socket, if the class has no one.
    If Not SocketExists Then Exit Sub ':(燛xpand Structure or consider reversing Condition
    '
    'The listen Winsock API function cannot be called
    'without the call of the bind one.
    If Not m_blnSocketIsBound Then  'Added: 10-MAR-2002
        Call Bind
    End If                          'Added: 10-MAR-2002
    '
    'Turn the socket into a listening state
    lngRetValue = api_listen(m_lngSocketHandle, 5&)
    '
    If lngRetValue = SOCKET_ERROR Then
        mvarState = sckError
        Err.Raise Err.LastDllError, "CSocket.Listen", GetErrorDescription(Err.LastDllError)
      Else 'NOT LNGRETVALUE...
        mvarState = sckListening
    End If
    '
EXIT_LABEL:
    '
Exit Sub
    '
Listen_Err_Handler:
    '
    Err.Raise Err.Number, "CSocket.Listen", Err.Description
    '
    GoTo EXIT_LABEL
    '
End Sub
Public Sub GetData(varData As Variant, Optional varType As Variant, Optional maxLen As Variant)
Attribute GetData.VB_Description = "Retrieve data sent by the remote computer"
  '
  Dim lngBytesReceived As Long    'value returned by the RecvData function
    '
    On Error GoTo GetData_Err_Handler
    '
    'A value of the second argument of the RecvData subroutine is False, so in this way
    'this procedure will retrieve incoming data from the buffer.
    lngBytesReceived = RecvData(varData, False, IIf(IsMissing(varType), Empty, varType), _
                       IIf(IsMissing(maxLen), Empty, maxLen))
    '
EXIT_LABEL:
    '
Exit Sub
    '
GetData_Err_Handler:
    '
    Err.Raise Err.Number, "CSocket.GetData", Err.Description
    '
    GoTo EXIT_LABEL
    '
End Sub
Public Sub Connect(Optional strRemoteHost As Variant, Optional lngRemotePort As Variant)
Attribute Connect.VB_Description = "Connect to the remote computer"
  '
    On Error GoTo Connect_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
    'overwrite values of the RemoteHost and RemotePort properties.
    '
    If Not IsMissing(strRemoteHost) Then    'Added: 04-MAR-2002
        If Len(strRemoteHost) > 0 Then
            m_strRemoteHost = CStr(strRemoteHost)
        End If
    End If                                  'Added: 04-MAR-2002
    '
    If Not IsMissing(lngRemotePort) Then    'Added: 04-MAR-2002
        If IsNumeric(lngRemotePort) Then    'Added: 04-MAR-2002
            m_lngRemotePort = CLng(lngRemotePort)
        End If                              'Added: 04-MAR-2002
    End If                                  'Added: 04-MAR-2002
    '
    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
    '
End Sub
Public Function vbSocket() As Long
  '********************************************************************************
  'Author    :Oleg Gdalevich
  'Purpose   :Creates a new socket
  'Returns   :The socket handle if successful, otherwise - INVALID_SOCKET
  'Arguments :
  '********************************************************************************
  '
    On Error GoTo vbSocket_Err_Handler
    '
  Dim lngRetValue     As Long 'value returned by the socket API function':(燤ove line to top of current Function
    '
    'Call the socket Winsock API function in order to create a new socket
    If mvarProtocol = sckUDPProtocol Then
        lngRetValue = api_socket(AF_INET, SOCK_DGRAM, IPPROTO_UDP)
      Else 'NOT MVARPROTOCOL...
        lngRetValue = api_socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
    End If
    '
    If lngRetValue = INVALID_SOCKET Then
        '
        Err.Raise Err.LastDllError, "CSocket.vbSocket", GetErrorDescription(Err.LastDllError)
        '
      Else 'NOT LNGRETVALUE...
        '
        '
        If MSocketSupport.RegisterSocket(lngRetValue, ObjPtr(Me)) Then
            '
            'Assign returned value
            vbSocket = lngRetValue
            '
          Else 'NOT MSOCKETSUPPORT.REGISTERSOCKET(LNGRETVALUE,...
            '
            'Err.Raise Err.LastDllError, "CSocket.vbSocket", GetErrorDescription(Err.LastDllError)
            '
        End If
        '
    End If
    '
EXIT_LABEL:
Exit Function
vbSocket_Err_Handler:
    '
    vbSocket = INVALID_SOCKET
    '
End Function
Friend Sub PostSocketEvent(ByVal lngEventID As Long, Optional ByVal lngError As Long)
  '
  'This procedure is called by the WindowProc callback function
  'from the MSocketSupport module. The lngEventID argument is an
  'ID of the network event occurred for the socket. The lngError
  'argument contains an error code only if an error was occurred
  'during an asynchronous execution.
  '
  Dim lngBytesReceived    As Long         'value returned by the RecvDataToBuffer function
  Dim lngRetValue         As Long         'value returned by the getsockname Winsock API function
  Dim lngNewSocket        As Long         'value returned by the accept Winsock API function
  Dim udtSockAddr         As sockaddr_in  'remote socket address for the accept Winscok API function
  Dim udtHostEnt          As HostEnt      'structure to hold the host info - returned
    '                                        by the gethostbyaddr Winsock API function
    '
    On Error GoTo ERROR_HANDLER
    '
    If lngError > 0 Then
        '
        'An error was occured.
        '
        'Change a value of the State property
        mvarState = sckError
        'Close the socket
        Call DestroySocket
        'The OnError event is just for this case
        RaiseEvent OnError(CInt(lngError), GetErrorDescription(lngError), 0, "", "", 0, False)
        'We have nothing to do here anymore
        Exit Sub '>---> Bottom
        '
    End If
    '
    Select Case lngEventID
        '
      Case FD_READ
        '
        '
        'Some data has arrived for this socket.
        'Call the RecvDataToBuffer function that move arrived data
        'from the Winsock buffer to the local one and returns number
        'of bytes received.
        lngBytesReceived = RecvDataToBuffer
        '
        '
        'The BytesReceived property contains number of bytes in
        'the local buffer of the class.
        m_lngBytesReceived = m_lngBytesReceived + lngBytesReceived
        '
        'The OnDataArrival event is just for the case when some data
        'was retieved from the Winsock buffer.
        If lngBytesReceived > 0 Then
            RaiseEvent OnDataArrival(Len(m_strRecvBuffer))
        End If
        '
      Case FD_WRITE
        '
        'This message means that the socket in a write-able
        'state, that is, buffer for outgoing data of the transport
        'service is empty and ready to receive data to send through
        'the network.
        '
        '
        'If the local buffer for outgoing data (m_strSendBuffer) is
        'not empty, the previous call of the send/sendto Winsock API
        'function was failed. Call the SendBufferedData procedure in
        'oreder to try to send that data again.
        If Len(m_strSendBuffer) > 0 Then
            '
            Call SendBufferedData
            '
        End If
        '
      Case FD_OOB
        '
        'Ignored.
        '
      Case FD_ACCEPT
        '
        'When the socket is in a listening state, arrival of this message
        'means that a connection request was received. Call the accept
        'Winsock API function in oreder to create a new socket for the
        'requested connection.
        lngNewSocket = api_accept(m_lngSocketHandle, udtSockAddr, Len(udtSockAddr))
        '
        '
        'Let the client application know that the request was received
        'and pass with the event argument a handle of the recently created
        'socket. The client application should create a new instance of
        'the CSocket class, and then use the socket handle (lngNewSocket)
        'to initialize its properties. Another way is to do not create
        'one more instance of this class. We may close existing socket,
        'and then accept the new handle:
        '
        '  Private Sub objSocket_OnConnectionRequest(ByVal requestID As Long)
        '      If objSocket.State <> sckClosed Then objSocket.CloseSocket
        '      objSocket.Accept (requestID)
        '  End Sub
        '
        RaiseEvent OnConnectionRequest(lngNewSocket)
        '
      Case FD_CONNECT
        '
        'Arrival of this message means that the connection initiated by the call
        'of the connect Winsock API function was successfully established.
        '
        'Get the connection local end-point parameters
        '
        lngRetValue = getsockname(m_lngSocketHandle, udtSockAddr, LenB(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
        '
        ' -- Modified: 04-MAR-2002 --
        '
        'Change a value of the State property
        mvarState = sckConnected
        '
        'Let the client app know that the connection was established.
        RaiseEvent OnConnect
        '
        ' -- --------------------- --
        '
        '
      Case FD_CLOSE
        '
        'This message means that the remote host is closing the conection
        '
        If mvarState = sckClosing Then
            '
            'If a value of the State property already is sckClosing,
            'the closing of the connection was initiated by the local
            'end-point (this socket) of the connection. In other words,
            'the shutdown Winsock API function has been called before
            '(the FIN segment is already sent by the local end-point).
            '
            'In this case we need wait until all the data sent by the
            'remote end-point of the connection will be received.
            '
            Do
                '
                lngBytesReceived = RecvDataToBuffer
                '
                If lngBytesReceived > 0 Then
                    RaiseEvent OnDataArrival(Len(m_strRecvBuffer))
                End If
                '
            Loop Until lngBytesReceived = 0 Or lngBytesReceived = SOCKET_ERROR
            '
          Else 'NOT MVARSTATE...
            '
            mvarState = sckClosing
            '
            'If a value of the State property is not sckClosing, the
            'connectoin is closing by the remote end-point of the
            'connection (the FIN segment is sent by the remote host).
            'In this case we need send all the remained data from the
            'local buffer before to close the socket.
            If Len(m_strSendBuffer) > 0 Then
                '
                Call SendBufferedData
                '
            End If
            '
        End If
        '
        'Close the socket
        Call DestroySocket
        '
        'Change a value of the State property
        mvarState = sckClosed
        '
        'Let the client app that the connection is closed
        RaiseEvent OnClose
        '
    End Select
    '
Exit Sub
    '
ERROR_HANDLER:
    '
    Err.Raise Err.Number, "CSocket.PostSocketEvent", Err.Description    'Modified: 15-APR-2002
    '
End Sub
Friend Sub PostGetHostEvent(ByVal lngRequestID As Long, ByVal lngHostAddress As Long, strHostName As String, Optional lngError As Long)
  '
  'This procedure is called by the WindowProc callback function
  'from the MSocketSupport module. Think about it as about result
  'returned by the ResolveHost function called from this class.
  '
  Dim udtAddress      As sockaddr_in  'socket address - used by the connect Winsock API function
  Dim lngRetValue     As Long         'value returned by the connect Winsock API function
  Dim lngPtrToAddress As Long         'pointer to the string that contains IP address - value
    'returned by the inet_ntoa Winsock API function
    '
    On Error GoTo ERROR_HANDLER
    '
    If lngError > 0 Then
        '
        'An error was occerred during resolving the host hame.
        'For example: "Host not found"
        '
        '----------------------------------------------------------------
        'Added: 28-APR-2002
        'There is the case when a computer has a valid IP address
        'but its name cannot be resolved. In this case the code should
        'countinue the execution - we just don't need to change the
        'RemoteHost property value.
        '----------------------------------------------------------------
        '
        'Does the strHostName argument contain a valid IP address?
        lngHostAddress = inet_addr(strHostName)
        '
        If lngHostAddress = INADDR_NONE Then    'Added: 28-APR-2002
            '
            'Change a value of the State property
            mvarState = sckError
            '
            'Let the client app that an error was occurred.
            RaiseEvent OnError(CInt(lngError), GetErrorDescription(lngError), 0, "", "", 0, False)
            '
            Exit Sub '>---> Bottom
            '
          Else    'Added: 28-APR-2002'NOT LNGHOSTADDRESS...
            '
            'Nothing to do here
            'Both properties the RemoteHost and RemoteHostIP
            'have the same value of the IP address string.
            '
        End If  'Added: 28-APR-2002
        '
    End If
    '
    'Check the id value - Do we really need this?
    If lngRequestID = 0 Then Exit Sub ':(燛xpand Structure or consider reversing Condition
    '
    If lngRequestID = m_lngRequestID Then
        '
        'Change a value of the State property
        mvarState = sckHostResolved
        '
        'Initialize the RemoteHost property
        m_strRemoteHost = strHostName
        '
        'Get pointer to the string that contains the IP address
        lngPtrToAddress = inet_ntoa(lngHostAddress)
        '
        'Retrieve that string by the pointer and init the
        'RemoteHostIP property.
        m_strRemoteHostIP = StringFromPointer(lngPtrToAddress)
        '
        'The ResolveHost function may be called from two methods
        'of the class: Connect and SendData. The m_varInternalState
        'variable tells us where the ResolveHost function called
        'from, and thus what to do here.
        '
        If m_varInternalState = istConnecting Then
            '
            'The ResolveHost was called from the Connect method, so
            'we need to continue the process of the connection establishing.
            '
            'Build the sockaddr_in structure to pass it to the connect
            'Winsock API function as an address of the remote host.
            With udtAddress
                '
                .sin_addr = lngHostAddress
                .sin_family = AF_INET
                .sin_port = htons(UnsignedToInteger(CLng(m_lngRemotePort)))
                '
            End With 'UDTADDRESS
            '
            'Call the connect Winsock API function in order to establish connection.
            lngRetValue = api_connect(m_lngSocketHandle, udtAddress, Len(udtAddress))
            '
            'Since the socket we use is a non-blocking one, the connect Winsock API
            'function should return a value of SOCKET_ERROR anyway.
            '
            If lngRetValue = SOCKET_ERROR Then
                '
                'The WSAEWOULDBLOCK error is OK for such a socket
                '
                If Not Err.LastDllError = WSAEWOULDBLOCK Then
                    Err.Raise Err.LastDllError, "CSocket.PostGetHostEvent", GetErrorDescription(Err.LastDllError)
                  Else 'NOT NOT...
                    'Change the State property value
                    mvarState = sckConnecting
                End If
                '
            End If
            '
          ElseIf m_varInternalState = istSendingDatagram Then 'NOT M_VARINTERNALSTATE...
            '
            'The ResolveHost was called from the SendData method in
            'the case when a message-oriented (UDP) socket is used.
            '
            Call SendBufferedData
            '
        End If
        '
    End If
    '
Exit Sub
    '
ERROR_HANDLER:
    '
    Err.Raise Err.Number, "CSocket.PostGetHostEvent", Err.Description
    '
End Sub
Private Function SocketExists() As Boolean
  '
    If m_lngSocketHandle = INVALID_SOCKET Then
        '
        'If the m_lngSocketHandle is not a valid value, call
        'the vbSocket function in order to create a new socket
        m_lngSocketHandle = vbSocket
        '
        If m_lngSocketHandle = SOCKET_ERROR Then
            '
            'A value of SOCKET_ERROR means that the socket was not created.
            'In this case the SocketExists function must return False
            Exit Function '>---> Bottom
            '
          Else 'NOT M_LNGSOCKETHANDLE...
            '
            'Get default size of the Winsock's buffers.
            Call GetWinsockBuffers  'Modified: 10-MAR-2002
            '
        End If
        '
    End If
    '
    'The m_lngSocketHandle variable contains a valid socket
    'handle value. In this case the function returns True.
    SocketExists = True
    '
End Function
Private Sub GetWinsockBuffers()
  '
  'This subroutine is to retrieve default size of the Winsock buffers.
  'These values will be stored in the module level variables:
  'm_lngSendBufferLen and m_lngRecvBufferLen.
  'It can be called from the SocketExists and Accept functions.
  '
  'Added: 10-MAR-2002
  '
  Dim lngRetValue     As Long 'value returned by the getsockopt Winsock API function
  Dim lngBuffer       As Long 'buffer to pass with the getsockopt call
    '
    If mvarProtocol = sckTCPProtocol Then
        'Buffer for incoming data
        lngRetValue = getsockopt(m_lngSocketHandle, SOL_SOCKET, SO_RCVBUF, lngBuffer, 4&)
        m_lngRecvBufferLen = lngBuffer
        'Buffer for outgoing data
        lngRetValue = getsockopt(m_lngSocketHandle, SOL_SOCKET, SO_SNDBUF, lngBuffer, 4&)
        m_lngSendBufferLen = lngBuffer
      Else 'NOT MVARPROTOCOL...
        'the m_lngMaxMsgSize value is returned by InitWinsockService
        'function from the MSocketSupport module
        m_lngSendBufferLen = m_lngMaxMsgSize
        m_lngRecvBufferLen = m_lngMaxMsgSize
    End If
    '
End Sub
Private Function RecvDataToBuffer() As Long
  '
  'This function is to retrieve data from the Winsock buffer
  'into the class local buffer. The function returns number
  'of bytes retrieved (received).
  '
  Dim lngBytesReceived        As Long     'value returned by recv/recvfrom Winsock API function
  Dim lngRetValue             As Long     'value returned by gethostbyaddr Winsock API function
  Dim strTempBuffer           As String   'just a temporary buffer
  Dim arrBuffer()             As Byte     'buffer to pass to the recv/recvfrom Winsock API function
  Dim udtSockAddr             As sockaddr_in 'socket address of the remote peer
  Dim lngSockAddrLen          As Long     'size of the sockaddr_in structure
  Dim udtHostEnt              As HostEnt  'used to get host name with gethostbyaddr function
    '
    'Prepare the buffer to pass it to the recv/recvfrom Winsock API function.
    'The m_lngRecvBufferLen variable was initialized during creating
    'of the socket, see the vbSocket function to find out how.
    ReDim arrBuffer(m_lngRecvBufferLen - 1)
    '
    If mvarProtocol = sckTCPProtocol Then
        '
        'If the socket is a connection-oriented one, just call the recv function
        'to retrieve all the arrived data from the Winsock buffer.
        lngBytesReceived = recv(m_lngSocketHandle, arrBuffer(0), m_lngRecvBufferLen, 0&)
        '
      Else 'NOT MVARPROTOCOL...
        '
        'If the socket uses UDP, it's another story. As stated in the MS Winsock Control
        'documentation after receiving data the RemoteHost, RemoteHostIP, and RemotePort
        'properties contains parameters of the machine sending the UDP data. To achive
        'such a behavior we must use the recvfrom Winsock API function.
        '
        lngSockAddrLen = Len(udtSockAddr)
        '
        lngBytesReceived = recvfrom(m_lngSocketHandle, arrBuffer(0), m_lngRecvBufferLen, _
                           0&, udtSockAddr, lngSockAddrLen)
        '
        If Not lngBytesReceived = SOCKET_ERROR Then
            '
            'Now the udtSockAddr contains a socket address of the remote host.
            'Initialize the RemoteHost, RemoteHostIP, and RemotePort properties.
            '
            With udtSockAddr
                '
                'RemotePort property
                m_lngRemotePort = IntegerToUnsigned(ntohs(.sin_port))
                'RemoteHostIP property
                m_strRemoteHostIP = StringFromPointer(inet_ntoa(.sin_addr))
                'RemoteHost property
                lngRetValue = gethostbyaddr(.sin_addr, 4&, AF_INET)
                CopyMemory udtHostEnt, ByVal lngRetValue, Len(udtHostEnt)
                m_strRemoteHost = StringFromPointer(udtHostEnt.hName)
                '
            End With 'UDTSOCKADDR
            '
        End If
        '
    End If
    '
    If lngBytesReceived > 0 Then
        '
        'Convert a byte array into the VB string
        strTempBuffer = StrConv(arrBuffer(), vbUnicode)
        'Store received data in the local buffer for incoming data - m_strRecvBuffer
        m_strRecvBuffer = m_strRecvBuffer & Left$(strTempBuffer, lngBytesReceived)
        'Return number of received bytes.
        RecvDataToBuffer = lngBytesReceived
        '
      ElseIf lngBytesReceived = SOCKET_ERROR Then 'NOT LNGBYTESRECEIVED...
        '
        Err.Raise Err.LastDllError, "CSocket.RecvToBuffer", GetErrorDescription(Err.LastDllError)
        '
    End If
    '
End Function
Private Function RecvData(varData As Variant, blnPeek As Boolean, Optional varType As Variant, Optional maxLen As Variant) As Long
  '
  'This function is to retrieve data from the local buffer (m_strRecvBuffer).
  'It can be called by two public methods of the class - GetData and PeekData.
  'Behavior of the function is defined by the blnPeek argument. If a value of
  'that argument is True, the function returns number of bytes in the
  'local buffer, and copy data from that buffer into the varData argument.
  'If a value of the blnPeek is False, then this function returns number of
  'bytes received, and move data from the local buffer into the varData
  'argument. MOVE means that data will be removed from the local buffer.
  '
  Dim strRecvData As String   'temporary string buffer
  Dim arrBuffer() As Byte     'temporary byte array buffer
    '
    'If the local buffer is empty, go away - we have nothing to do here.
    If Len(m_strRecvBuffer) = 0 Then Exit Function ':(燛xpand Structure or consider reversing Condition
    '
    If IsEmpty(maxLen) Then
        maxLen = 0
    End If
    '
    If (Not maxLen > Len(m_strRecvBuffer)) And (maxLen > 0) Then
        '
        strRecvData = Left$(m_strRecvBuffer, CLng(maxLen))
        '
        If Not blnPeek Then
            m_strRecvBuffer = Mid$(m_strRecvBuffer, CLng(maxLen + 1))
        End If
        '
        arrBuffer() = StrConv(strRecvData, vbFromUnicode)
        '
      Else 'NOT (NOT...
        '
        arrBuffer() = StrConv(m_strRecvBuffer, vbFromUnicode)
        '
        If Not blnPeek Then
            m_strRecvBuffer = ""
        End If
        '
    End If
    '
    If IsEmpty(varType) Then
        varData = CStr(StrConv(arrBuffer(), vbUnicode))
      Else 'ISEMPTY(VARTYPE) = FALSE
        '
        Select Case varType
          Case vbArray + vbByte
            'Modified 28-MAY-2002. Thanks to Michael Freidgeim
            '--------------------------------
            'Dim strArray As String
            'strArray = StrConv(arrBuffer(), vbUnicode)
            'varData = StrConv(strArray, vbFromUnicode)
            varData = arrBuffer()
            '--------------------------------
          Case vbBoolean
  Dim blnData As Boolean ':(燤ove line to top of current Function
            CopyMemory blnData, arrBuffer(0), LenB(blnData)
            varData = blnData
          Case vbByte
  Dim bytData As Byte ':(燤ove line to top of current Function
            CopyMemory bytData, arrBuffer(0), LenB(bytData)
            varData = bytData
          Case vbCurrency
  Dim curData As Currency ':(燤ove line to top of current Function
            CopyMemory curData, arrBuffer(0), LenB(curData)
            varData = curData
          Case vbDate
  Dim datData As Date ':(燤ove line to top of current Function
            CopyMemory datData, arrBuffer(0), LenB(datData)
            varData = datData
          Case vbDouble
  Dim dblData As Double ':(燤ove line to top of current Function
            CopyMemory dblData, arrBuffer(0), LenB(dblData)
            varData = dblData
          Case vbInteger
  Dim intData As Integer ':(燤ove line to top of current Function
            CopyMemory intData, arrBuffer(0), LenB(intData)
            varData = intData
          Case vbLong
  Dim lngData As Long ':(燤ove line to top of current Function
            CopyMemory lngData, arrBuffer(0), LenB(lngData)
            varData = lngData
          Case vbSingle
  Dim sngData As Single ':(燤ove line to top of current Function
            CopyMemory sngData, arrBuffer(0), LenB(sngData)
            varData = sngData
          Case vbString
  Dim strData As String ':(燤ove line to top of current Function
            strData = StrConv(arrBuffer(), vbUnicode)
            varData = strData
            '
        End Select
        '
    End If
    '
    'Added 28-MAY-2002. Thanks to Michael Freidgeim
    m_lngBytesReceived = Len(m_strRecvBuffer) 'reset BytesReceived after Getdata
    '
End Function
Private Sub DestroySocket()
  '
  'The purpose of this subroutine is to unregister the socket with
  'UnregisterSocket that can be found in the MSocketSupport module
  'and close the socket with the closesocket Winsock API function.
  '
  Dim lngRetValue As Long 'value returned by the closesocket
    'Winsock AP function
    '
    If Not m_lngSocketHandle = INVALID_SOCKET Then
        '
        'Unregister the socket. For more info on how it works
        'see the code of the function in the MSocketSupport module
        Call MSocketSupport.UnregisterSocket(m_lngSocketHandle)
        '
        'Close the socket with the closesocket Winsock API function.
        lngRetValue = api_closesocket(m_lngSocketHandle)
        '
        '
        If lngRetValue = SOCKET_ERROR Then
            Err.Raise Err.LastDllError, "CSocket.DestroySocket", GetErrorDescription(Err.LastDllError)
        End If
        '
        'Change the SocketHandle property value
        m_lngSocketHandle = INVALID_SOCKET
        '
        'If the bind Winsock API function has been called on
        'this socket, m_blnSocketIsBound = True. We need to
        'change this value.
        m_blnSocketIsBound = False  'Added: 10-MAR-2002
        '
    End If
    '
End Sub
Private Sub Class_Terminate()
  '
    If Not m_lngSocketHandle = INVALID_SOCKET Then
        Call DestroySocket
    End If
    '
    Call CleanupWinsock
    '
End Sub
Private Sub SendBufferedData()
  '
  'This procedure sends data from the local buffer (m_strSendBuffer).
  'The data from the client application is passed with the SendData
  'method of the class as an argument and is stored in the local
  'buffer until all the data from that buffer will be sent using this
  'subroutine.
  '
  'Why do we need to store data in the local buffer? There are some
  'things happenning in the Winsock's buffer for outgoing data since
  'we're using non-blocking sockets' calls. If that buffer is full,
  'the transport subsystem doesn't take the data and the send/sendto
  'functions return a value of SOCKET_ERROR, Err.LastDllError give
  'us a value of WSAEWOULDBLOCK. This means that if the socket would
  'be a blocking one, such a call would block socket until the buffer
  'will be freed and ready to accept some data to send.
  '
  'So this procedure can be called several (mostly not more than two)
  'times for the same chunk of data. First call is in the body of the
  'SendData method, and other calls (if necessary) will be performed
  'from the PostSocketEvent subroutine, as soon as the FD_WRITE message
  'will be received. The arrival of the FD_WRITE message means that a
  'socket is in a write-able state - its buffer is ready to get data.
  '
  Dim lngRetValue     As Long         'value returned by send/sendto Winsock API function
  Dim arrData()       As Byte         'data to send with the send/sendto function
  Dim lngBufferLength As Long         'size of the data buffer to send
  Dim udtSockAddr     As sockaddr_in  'address of the remote socket - for the sendto function
    '
    'The send/sendto function needs this value for one of its arguments
    lngBufferLength = Len(m_strSendBuffer)
    '
    'Convert data from a VB string to a byte array
    arrData() = StrConv(m_strSendBuffer, vbFromUnicode)
    '
    If mvarProtocol = sckTCPProtocol Then
        '
        'just call the send function in order to send data via connection
        lngRetValue = send(m_lngSocketHandle, arrData(0), lngBufferLength, 0&)
        '
      Else 'NOT MVARPROTOCOL...
        '
        'With UDP socket we are going to use the sendto Winsock API function.
        'This function needs the socket address of the remote host to send
        'message to.
        '
        If Len(m_strRemoteHostIP) = 0 Then
            '
            'If the RemoteHostIP property is empty, we don't know
            'the remote IP so we need to resolve that address.
            '
            m_varInternalState = istSendingDatagram
            m_lngRequestID = MSocketSupport.ResolveHost(m_strRemoteHost, ObjPtr(Me))
            '
            'The ResolveHost is an asynchronous call. This subroutine wiil be called
            'one more time from the PostGetHostEvent procedure when the host will be
            'resolved.
            '
          Else 'NOT LEN(M_STRREMOTEHOSTIP)...
            '
            'If we are here the host was resolved successfully and the RemoteHostIP
            'property provides us with IP to send a UDP message to.
            '
            'Build the sockaddr_in structure to pass the remote socket address
            'to the sendto function.
            With udtSockAddr
                .sin_addr = inet_addr(m_strRemoteHostIP)
                .sin_port = htons(UnsignedToInteger(m_lngRemotePort))
                .sin_family = AF_INET
            End With 'UDTSOCKADDR
            '
            'Call the sendto function in order to send a UDP message
            lngRetValue = sendto(m_lngSocketHandle, arrData(0), lngBufferLength, 0&, udtSockAddr, Len(udtSockAddr))
            '
        End If
        '
    End If
    '
    If lngRetValue = SOCKET_ERROR Then
        '
        'If a value of Err.LastDllError is WSAEWOULDBLOCK, that means
        'that the Winsock's buffer for outgoing data is full and cannot
        'accept data to send. In this case we ignore this error and do
        'not empty local buffer (m_strSendBuffer).
        '
        If Not Err.LastDllError = WSAEWOULDBLOCK Then
            Err.Raise Err.LastDllError, "CSocket.SendData", GetErrorDescription(Err.LastDllError)
        End If
        '
      Else 'NOT LNGRETVALUE...
        '
        'The data were sent successfully. Raise the OnSendProgress or
        'OnSendComplete event to let the client app know.
        '
        '
        If Len(m_strSendBuffer) > lngRetValue Then
            '
            m_strSendBuffer = Mid$(m_strSendBuffer, lngRetValue + 1)
            '
          Else 'NOT LEN(M_STRSENDBUFFER)...
            m_strSendBuffer = ""
            RaiseEvent OnSendComplete
        End If
        '
        RaiseEvent OnSendProgress(lngRetValue, Len(m_strSendBuffer))
        '
    End If
    '
End Sub

						