?? csocket.cls
字號:
'
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -