Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'
'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
'
Private m_blnSendFlag As Boolean 'Added: 12-SEP-2002
'
'This flag variable indicates that the SO_BROADCAST option
'is set on the socket
Private m_blnBroadcast As Boolean 'Added: 09-JULY-2002
'
'These are those MS Winsock's events.
'Pay attention that the "On" prefix is added.
Public Event OnClose()
Public Event OnConnect()
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)
'
'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
'length of the data to send - needed to call the send(sendto) Winsock API function
Dim lngBufferLength As Long
'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
'
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
End If
'
Else
'
'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
'
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
blnData = CBool(varData)
ReDim arrData(LenB(blnData) - 1)
CopyMemory arrData(0), blnData, LenB(blnData)
Case vbByte
Dim bytData As Byte
bytData = CByte(varData)
ReDim arrData(LenB(bytData) - 1)
CopyMemory arrData(0), bytData, LenB(bytData)
Case vbCurrency
Dim curData As Currency
curData = CCur(varData)
ReDim arrData(LenB(curData) - 1)
CopyMemory arrData(0), curData, LenB(curData)
Case vbDate
Dim datData As Date
datData = CDate(varData)
ReDim arrData(LenB(datData) - 1)
CopyMemory arrData(0), datData, LenB(datData)
Case vbDouble
Dim dblData As Double
dblData = CDbl(varData)
ReDim arrData(LenB(dblData) - 1)
CopyMemory arrData(0), dblData, LenB(dblData)
Case vbInteger
Dim intData As Integer
intData = CInt(varData)
ReDim arrData(LenB(intData) - 1)
CopyMemory arrData(0), intData, LenB(intData)
Case vbLong
Dim lngData As Long
lngData = CLng(varData)
ReDim arrData(LenB(lngData) - 1)
CopyMemory arrData(0), lngData, LenB(lngData)
Case vbSingle
Dim sngData As Single
sngData = CSng(varData)
ReDim arrData(LenB(sngData) - 1)
CopyMemory arrData(0), sngData, LenB(sngData)
Case vbString
Dim strData As String
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.
m_blnSendFlag = True
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."
