Need another way for accepting incoming socket requests

[RenRoe]

1.)

WinSock control uses the event
ConnectionRequest(byval requestID As Long)

This request ID indeed is the socket handle returned by WS2_32 accept.

I use this temporary socket handle to be duplicated to another process already started to handle the connection in another process.

Example of forwarding of a socket handle to another process:

Private Sub Runtime_ConnectionRequest(ByRef requestID As Long)
    Dim SourceProcID As Long, SourceProcHandle As Long, DestProcID As Long, DestProcHandle As Long
    Dim DupHandle As Long, ret As Long
    Dim ServerClient As Object
    
    Dim XApp As Object, TCPOb As Object
    
    'retrieve my own process handle
    SourceProcID = GetCurrentProcessId
    SourceProcHandle = OpenProcess(PROCESS_DUP_HANDLE, 0, SourceProcID)
    
    'start new server process managing the incoming connection (here: standalone COM-EXE)
    'Advantage: Process has full 2^31 bytes memory - Process can be stopped independent of other connections
    'Process has its own error management - crashes won't stop other already running connections;
    'Async processing 

    Set ServerClient = CreateObject("TCES.TCPConnector")
    
    'get the process ID and handle of the new process 
    DestProcID = ServerClient.GetProcessID
    DestProcHandle = OpenProcess(PROCESS_DUP_HANDLE, 0, DestProcID)
            
    If DestProcHandle Then
        'duplicate socket handle for usage in the new process
        ret = DuplicateHandle(SourceProcHandle, requestID, DestProcHandle, DupHandle, 0, 0, DUPLICATE_SAME_ACCESS)
        
        'Accept the duplicated handle in child server process 
        If ret=1 Then ServerClient.DoAccept DupHandle
        
        CloseHandle DestProcHandle
    End If
    
    CloseHandle SourceProcHandle
    
End Sub

The DoAccept of the child process uses the Attach function of a cAsyncSocket object

It would be nice to change or append the events of the class, and make it more compatible to WinSock control.

    If m_lLastError <> 0 Then
        RaiseEvent OnError(m_lLastError, eEvent)
        GoTo QH
    End If
    RaiseEvent BeforeNotify(eEvent, bCancel)
    If bCancel Then
        GoTo QH
    End If
    Select Case eEvent
    Case ucsSfdRead
        If Not IOCtl(FIONREAD, lBytes) Then
            RaiseEvent OnError(m_lLastError, eEvent)
            If m_hSocket = INVALID_SOCKET Then
                GoTo QH
            End If
        End If
        If lBytes <> 0 Then
            RaiseEvent OnReceive
        End If
    Case [_ucsSfdForceRead]
        RaiseEvent OnReceive
    Case ucsSfdWrite
        RaiseEvent OnSend
    Case ucsSfdConnect
        RaiseEvent OnConnect
    Case ucsSfdAccept
        RaiseEvent OnConnectionRequest(ws_accept(m_hSocket, ByVal 0, ByVal 0))
    Case ucsSfdClose
        RaiseEvent OnClose
    End Select

2.)

To let this run, there occurred a problem, that duplicating a socket copies the notification settings of the listener socket. The duplicated socket cannot send data.

The Bind method needs to be modified:

Public Function Bind(Optional SocketAddress As String, Optional ByVal SocketPort As Long) As Boolean
Const FUNC_NAME As String = "Bind"
Dim uAddr As SOCKADDR_IN

On Error GoTo EH
If Not pvToSockAddr(SocketAddress, SocketPort, uAddr) Then
    GoTo QH
End If

If WSAAsyncSelect(m_hSocket, m_oHelperWindow.frMessageHWnd, WM_SOCKET_NOTIFY, ucsSfdRead Or ucsSfdWrite Or ucsSfdAccept Or ucsSfdConnect Or ucsSfdClose) = SOCKET_ERROR Then
    m_lLastError = Err.LastDllError
    GoTo QH
End If

If ws_bind(m_hSocket, uAddr, LenB(uAddr)) = SOCKET_ERROR Then
    m_lLastError = Err.LastDllError
    GoTo QH
End If
'--- success
m_lLastError = 0
Bind = True

QH:
Exit Function
EH:
PrintError FUNC_NAME
End Function

Here you see the settings for notification of the listener, in additionWSAAsyncSelect to enable all types of events.

3.) there are a couple of problems with event handling

It would be a good idea to create an interface IAsyncSocket

Option Explicit

Public Sub BeforeNotify(ByVal EventMask As UcsAsyncSocketEventMaskEnum, Cancel As Boolean)

End Sub

Public Sub OnClose()

End Sub

Public Sub OnConnect()

End Sub

Public Sub OnConnectionRequest(ByVal requestID As Long)

End Sub

Public Sub OnError(ByVal ErrorCode As Long, ByVal EventMask As UcsAsyncSocketEventMaskEnum)

End Sub

Public Sub OnMessagePending(Handled As Boolean)

End Sub

Public Sub OnReceive()

End Sub

Public Sub OnResolve(IpAddress As String)

End Sub

Public Sub OnSend()

End Sub

and setting a callback reference while creation of the socket object. Every message of the helper window will be delivered to the callback reference instead of event raising. No problems with reentrancy anymore.

'new private member of cAsyncSocket
Private mInterface As IAsyncSocket

The callback interface is an additional parameter of Create.

Public Function Create( _
Optional ByVal SocketPort As Long, _
Optional ByVal SocketType As UcsAsyncSocketTypeEnum = ucsSckStream, _
Optional ByVal EventMask As UcsAsyncSocketEventMaskEnum = ucsSfdAll, _
Optional SocketAddress As String, _
Optional pCallbackInterface As IAsyncSocket) As Boolean

Const FUNC_NAME     As String = "Create"

Set mInterface = pCallbackInterface

On Error GoTo EH
If m_hSocket <> INVALID_SOCKET Then
    m_lLastError = WSAEALREADY
    GoTo QH
End If
If m_oHelperWindow.frMessageHWnd = 0 Then
    m_lLastError = WSANOTINITIALISED
    GoTo QH
End If
m_hSocket = ws_socket(AF_INET, SocketType, 0)
If m_hSocket = INVALID_SOCKET Then
    m_lLastError = Err.LastDllError
    GoTo QH
End If

Set m_pCleanup = InitCleanupThunk(m_hSocket, "ws2_32", "closesocket")

If Not AsyncSelect(EventMask) Then
    pvClose
    GoTo QH
End If

If SocketPort <> 0 Then
    If Not Bind(SocketAddress, SocketPort) Then
        pvClose
        GoTo QH
    End If
End If

'--- success
m_lLastError = 0
Create = True

QH:
Exit Function
EH:
PrintError FUNC_NAME
End Function

Private Sub pvDoNotify(ByVal wParam As Long, ByVal lParam As Long)
Dim eEvent As UcsAsyncSocketEventMaskEnum
Dim bCancel As Boolean
Dim lBytes As Long

If m_hSocket <> wParam Then
    GoTo QH
End If
eEvent = lParam And &HFFFF&
m_lLastError = lParam \ &H10000

If Not mInterface Is Nothing Then
    If m_lLastError <> 0 Then
        Call mInterface.OnError(m_lLastError, eEvent)
        GoTo QH
    End If
    Call mInterface.BeforeNotify(eEvent, bCancel)
    If bCancel Then
        GoTo QH
    End If
    Select Case eEvent
    Case ucsSfdRead
        If Not IOCtl(FIONREAD, lBytes) Then
            Call mInterface.OnError(m_lLastError, eEvent)
            If m_hSocket = INVALID_SOCKET Then
                GoTo QH
            End If
        End If
        If lBytes <> 0 Then
            Call mInterface.OnReceive
        End If
    Case [_ucsSfdForceRead]
        Call mInterface.OnReceive
    Case ucsSfdWrite
        Call mInterface.OnSend
    Case ucsSfdConnect
        Call mInterface.OnConnect
    Case ucsSfdAccept
        pvHandleAcceptInterface wParam, lParam
    Case ucsSfdClose
        Call mInterface.OnClose
    End Select
Else
    If m_lLastError <> 0 Then
        RaiseEvent OnError(m_lLastError, eEvent)
        GoTo QH
    End If
    RaiseEvent BeforeNotify(eEvent, bCancel)
    If bCancel Then
        GoTo QH
    End If
    Select Case eEvent
    Case ucsSfdRead
        If Not IOCtl(FIONREAD, lBytes) Then
            RaiseEvent OnError(m_lLastError, eEvent)
            If m_hSocket = INVALID_SOCKET Then
                GoTo QH
            End If
        End If
        If lBytes <> 0 Then
            RaiseEvent OnReceive
        End If
    Case [_ucsSfdForceRead]
        RaiseEvent OnReceive
    Case ucsSfdWrite
        RaiseEvent OnSend
    Case ucsSfdConnect
        RaiseEvent OnConnect
    Case ucsSfdAccept
        RaiseEvent OnConnectionRequest(ws_accept(m_hSocket, ByVal 0, ByVal 0))
    Case ucsSfdClose
        RaiseEvent OnClose
    End Select
End If

QH:
End Sub

[wqweto]

It would be nice to change or append the events of the class, and make it more compatible to WinSock control.

Winsock control has completely different events. There is a Winsock replacement control in the repo in contrib directory that uses cAsyncSocket class to emulate Winsock control.

There is no point in emulating Winsock control directly in the cAsyncSocket class which is prototyped on MFC implementation, not on Winsock control methods/properties/events.

To let this run, there occurred a problem, that duplicating a socket copies the notification settings of the listener socket. The duplicated socket cannot send data.

You mean not copying notification settings? There is a optional EventMask parameter on Attach method that should be already calling WSAAsyncSelect.

You might try usign this param to set notifications to ucsSfdRead Or ucsSfdWrite Or ucsSfdAccept Or ucsSfdConnect Or ucsSfdClose like you do in your snippet although the default value of ucsSfdAll seems good enough to me.

Btw, your fix to Bind is calling WSAAsyncSelect with wrong parameters and cannot possible fix anything. Something else must have been going wrong here because this cannot be a fix for anything.

Every message of the helper window will be delivered to the callback reference instead of event raising. No problems with reentrancy anymore.

What reentrancy problems do you have? Can you post a sample code so that I can debug any problems with reentrancy you have?

Best would be to make a minimal project/project group that reproduces any problems you have and post a ZIP with all these sources so I can debug it here on my machine.