Code:
Public Function vbBind(ByVal lngSocket As Long, ByVal strLocalHost As String, ByVal lngLocalPort As Long) As Long
'----------------------------------------------------------------------------------------------------------------------
' Purpose: Binds the socket to the local address
' Return: If no error occurs, returns zero. Otherwise, it returns SOCKET_ERROR.
' Arguments: lngSocket - the socket to bind
' strLocalHost - name or IP address of the local host to bind to
' lngLocalPort - the port number to bind to
'----------------------------------------------------------------------------------------------------------------------
Dim udtSocketAddress As sockaddr_in
Dim lngReturnValue As Long
Dim lngAddress As Long
On Error GoTo ERROR_HANDLER
vbBind = SOCKET_ERROR
'
' Check the socket handle
'
If Not lngSocket > 0 Then
'
' TO DO: Inform the user or the calling procedure
' that the socket handle is invalid one
'
Exit Function
End If
'
' Check the local host address argument
'
If Len(strLocalHost) = 0 Then
'
' TO DO: Inform the user or the calling procedure
' that the strLocalHost argument can't be empty
'
Exit Function
End If
'
' Check the port number
'
If Not lngLocalPort > 0 Then
'
' TO DO: Inform the user or the calling procedure
' that the lngLocalPort must be a positive value
'
Exit Function
End If
'
'Prepare the sockaddr_in structure to pass to the
'bind Winsock API function
'
'The sin_family member of the structure needs
'the address family value that we can retieve
'with CProtocol class
'
Dim objProtocol As New CProtocol
Dim lngAdrFamily As Long
Call objProtocol.GetBySocketHandle(lngSocket)
lngAdrFamily = objProtocol.AddressFamily
Set objProtocol = Nothing
'
' The strLocalHost may contain the host name
' or IP address - GetAddressLong returns a valid
' value anyway
'
lngAddress = GetAddressLong(strLocalHost)
If lngAddress = INADDR_NONE Then
Exit Function
End If
With udtSocketAddress
.sin_addr = lngAddress
'
' Convert the port number to the network byte ordering
'
.sin_port = htons(UnsignedToInteger(lngLocalPort))
.sin_family = lngAdrFamily
End With
vbBind = bind(lngSocket, udtSocketAddress, LenB(udtSocketAddress))
EXIT_LABEL:
Exit Function
ERROR_HANDLER:
If Not objProtocol Is Nothing Then
Set objProtocol = Nothing
End If
vbBind = SOCKET_ERROR
End Function
Public Function GetIPEndPointField(ByVal lngSocket As Long, ByVal EndPointField As IPEndPointFields) As Variant
'----------------------------------------------------------------------------------------------------------------------
' Purpose Retrieves IP address or host name or port number of
' an end-point of the connection established
' on the socket - lngSocket
'
' Return: If no errors occures, the function returns the value
' requested by the EndPointField argument.
' Otherwise, it returns the value of SOCKET_ERROR
'
' Arguments:
' lngSocket - socket's handle. The socket must be connected to the remote host.
' EndPointField - specifies the value to return:
' LOCAL_HOST
' LOCAL_HOST_IP
' LOCAL_PORT
' REMOTE_HOST
' REMOTE_HOST_IP
' REMOTE_PORT
'----------------------------------------------------------------------------------------------------------------------
Dim udtSocketAddress As sockaddr_in
Dim lngReturnValue As Long
Dim lngPtrToAddress As Long
On Error GoTo ERROR_HANDLER
Select Case EndPointField
Case LOCAL_HOST, LOCAL_HOST_IP, LOCAL_PORT
'
' If the info of a local end-point of the connection is
' requested, call the getsockname Winsock API function
'
lngReturnValue = getsockname(lngSocket, udtSocketAddress, LenB(udtSocketAddress))
Case REMOTE_HOST, REMOTE_HOST_IP, REMOTE_PORT
'
' If the info of a remote end-point of the connection is
' requested, call the getpeername Winsock API function
'
lngReturnValue = getpeername(lngSocket, udtSocketAddress, LenB(udtSocketAddress))
End Select
If lngReturnValue = 0 Then
'
' If no errors were occurred, the getsockname or getpeername
' function returns 0.
'
Select Case EndPointField
Case LOCAL_PORT, REMOTE_PORT
'
' If the port number is requested, retrieve that value
' from the sin_port member of the udtSocketAddress
' structure, and change the byte order of that value from
' the network to host byte order.
'
GetIPEndPointField = IntegerToUnsigned(ntohs(udtSocketAddress.sin_port))
Case LOCAL_HOST_IP, REMOTE_HOST_IP
'
' The host address is stored in the sin_addr member of the structure
' as 4-byte value.
'
' To get an IP address of the host:
'
' Get pointer to the string that contains the IP address
'
lngPtrToAddress = inet_ntoa(udtSocketAddress.sin_addr)
'
' Retrieve that string by the pointer
'
GetIPEndPointField = StringFromPointer(lngPtrToAddress)
Case LOCAL_HOST, REMOTE_HOST
'
' The same procedure as for an IP address.
' But here is the GetHostNameByAddress function call
' to retrieve host name by IP address.
'
lngPtrToAddress = inet_ntoa(udtSocketAddress.sin_addr)
GetIPEndPointField = GetHostNameByAddress(StringFromPointer(lngPtrToAddress))
End Select
Else
GetIPEndPointField = SOCKET_ERROR
End If
EXIT_LABEL:
Exit Function
ERROR_HANDLER:
GetIPEndPointField = SOCKET_ERROR
End Function
Private Function GetHostNameByAddress(strIpAddress As String) As String
Dim lngInetAdr As Long
Dim lngPtrHostEnt As Long
Dim lngPtrHostName As Long
Dim strHostName As String
Dim udtHostent As HOSTENT
strIpAddress = Trim$(strIpAddress)
'
' Valid IP address contains at least 7 characters
'
If Len(strIpAddress) > 6 Then
'
' Convert the IP address string to Long
'
lngInetAdr = inet_addr(strIpAddress)
'
' ## Retrieve host name
'
' Get the pointer to the HostEnt structure
'
lngPtrHostEnt = gethostbyaddr(lngInetAdr, 4, AF_INET)
'
' Copy data into the HostEnt structure
'
RtlMoveMemory udtHostent, ByVal lngPtrHostEnt, LenB(udtHostent)
'
' Prepare the buffer to receive a string
'
strHostName = String(256, 0)
'
' Copy the host name into the strHostName variable
'
RtlMoveMemory ByVal strHostName, ByVal udtHostent.hName, 256
'
' Cut received string by first chr(0) character
'
strHostName = Left(strHostName, InStr(1, strHostName, Chr(0)) - 1)
'
' Return the found value
'
GetHostNameByAddress = strHostName
End If
End Function
Public Function vbSend(ByVal lngSocket As Long, strData As String) As Long
'----------------------------------------------------------------------------------------------------------------------
'Purpose: Sends data to the remote host with connected socket
'Returns: Number of bytes sent to the remote host
'Arguments: lngSocket - the socket connected to the remote host
' strData - data to send
'----------------------------------------------------------------------------------------------------------------------
Dim arrBuffer() As Byte
Dim lngBytesSent As Long
Dim lngBufferLength As Long
lngBufferLength = Len(strData)
If IsConnected(lngSocket) And lngBufferLength > 0 Then
'
' Convert the data string to a byte array
'
arrBuffer() = StrConv(strData, vbFromUnicode)
'
' Call the send Winsock API function in order to send data
'
lngBytesSent = send(lngSocket, arrBuffer(0), lngBufferLength, 0&)
vbSend = lngBytesSent
Else
vbSend = SOCKET_ERROR
End If
End Function
Public Function vbRecv(ByVal lngSocket As Long, strBuffer As String) As Long
'----------------------------------------------------------------------------------------------------------------------
'Purpose: Retrieves data from the Winsock buffer.
'Returns: Number of bytes received.
'Arguments: lngSocket - the socket connected to the remote host
' strBuffer - buffer to read data to
'----------------------------------------------------------------------------------------------------------------------
Const MAX_BUFFER_LENGTH As Long = 8192
Dim arrBuffer(1 To MAX_BUFFER_LENGTH) As Byte
Dim lngBytesReceived As Long
Dim strTempBuffer As String
'
' Check the socket for readabilty with
' the IsDataAvailable function
'
If IsDataAvailable(lngSocket) Then
'
' Call the recv Winsock API function in order to read data from the buffer
'
lngBytesReceived = recv(lngSocket, arrBuffer(1), MAX_BUFFER_LENGTH, 0&)
If lngBytesReceived > 0 Then
'
' If we have received some data, convert it to the Unicode
' string that is suitable for the Visual Basic String data type
'
strTempBuffer = StrConv(arrBuffer, vbUnicode)
'
' Remove unused bytes
'
strBuffer = Left$(strTempBuffer, lngBytesReceived)
End If
'
' If lngBytesReceived is equal to 0 or -1, we have nothing to do with that
'
vbRecv = lngBytesReceived
Else
'
' Something wrong with the socket.
' Maybe the lngSocket argument is not a valid socket handle at all
'
vbRecv = SOCKET_ERROR
End If
End Function
Public Function vbListen(ByVal lngSocketHandle As Long) As Long
'----------------------------------------------------------------------------------------------------------------------
'Purpose: Turns a socket into a listening state.
'Return: If no error occurs, returns zero. Otherwise, it returns SOCKET_ERROR.
'Arguments: lngSocketHandle - the socket to turn into a listening state.
'----------------------------------------------------------------------------------------------------------------------
Dim lngRetValue As Long
lngRetValue = listen(lngSocketHandle, SOMAXCONN)
vbListen = lngRetValue
'
' We have nothing to do as vbListen function returns the same value
' as the listen Winsock API function.
'
End Function
Public Function vbAccept(ByVal lngSocketHandle As Long) As Long
'----------------------------------------------------------------------------------------------------------------------
'Purpose: Accepts a connection request, and creates a new socket.
'Return: If no error occurs, returns the new socket's handle. Otherwise, it returns INVALID_SOCKET.
'Arguments: lngSocketHandle - the listening socket.
'----------------------------------------------------------------------------------------------------------------------
Dim lngRetValue As Long
Dim udtSocketAddress As sockaddr_in
Dim lngBufferSize As Long
'
' Calculate the buffer size
'
lngBufferSize = LenB(udtSocketAddress)
'
' Call the accept Winsock API function in order to create a new socket
'
lngRetValue = accept(lngSocketHandle, udtSocketAddress, lngBufferSize)
vbAccept = lngRetValue
End Function
Public Function IsConnected(ByVal lngSocket As Long) As Boolean
Dim udtRead_fd As fd_set
Dim udtWrite_fd As fd_set
Dim udtError_fd As fd_set
Dim lngSocketCount As Long
udtWrite_fd.fd_count = 1
udtWrite_fd.fd_array(1) = lngSocket
lngSocketCount = vbselect(0&, udtRead_fd, udtWrite_fd, udtError_fd, 0&)
IsConnected = CBool(lngSocketCount)
End Function
Public Function IsDataAvailable(ByVal lngSocket As Long) As Boolean
Dim udtRead_fd As fd_set
Dim udtWrite_fd As fd_set
Dim udtError_fd As fd_set
Dim lngSocketCount As Long
udtRead_fd.fd_count = 1
udtRead_fd.fd_array(1) = lngSocket
lngSocketCount = vbselect(0&, udtRead_fd, udtWrite_fd, udtError_fd, 0&)
IsDataAvailable = CBool(lngSocketCount)
End Function
Reply With Quote
Originally Posted by Ben321
