wqweto / vbasyncsocket Goto Github PK

I've tried out your VbAsyncSocket class in a VB5 project and the IDE crashes whenever trying to listen, connect, send or receive data. I tried the same project under the VB6 IDE and they seem to work fine. I suspect your thunks are not compatible with the VB5 IDE.

Could you please add support for VB5?

Hi,
Can I ask you please to help me with ports leaking?

I prepared and attached another one simple samples (based on your chat samples and my previous forms #7 ), you may want (or may not) include them as samples in your project in the future.

This time without controls at all.
I moved the operational part to separate classes to minimize code size in the main form module.

There are 3 projects:

1. Client
2. Server
3. Client-Server (same as 1 + 2, merged together).

If you try to send several packets (using project # 3, or bunch of # 1 + # 2), you will see, that ports are get occupied with status "Time Wait", which is automatically free by system after ~ 120 sec. However, those should have been instantly free with Socket.Close_ method. Why it doesn't want to?

Thanks a lot for your help.

Attachment: https://dragokas.com/temp/Socket-samples.zip (can't attach for some reason).

Hello Vladimir,
How do I start to access an FTP(S) or SFTP server with VB6.

A short introduction (example) would be nice.

greeting

mdTlsNative will not make a connection. Any attempt results in error number "-2147221504" with a description "The message received was unexpected or badly formatted."

for this

 With New cTlsClient
   . SetTimeouts 0, 5000, 5000, 5000
    .Connect "smtp.gmail.com", 587
    Debug.Print .ReadText();
    .WriteText "HELO 127.0.0.1" & vbCrLf
    Debug.Print .ReadText();
    .WriteText "STARTTLS" & vbCrLf
    Debug.Print .ReadText();
    .StartTls "smtp.gmail.com"
    Debug.Print "TLS handshake complete: " & .TlsHostAddress
    .WriteText "QUIT" & vbCrLf
    Debug.Print .ReadText();
End With

we get this

220 smtp.gmail.com ESMTP l8sm10315047wmf.39 - gsmtp
250 smtp.gmail.com at your service
220 2.0.0 Ready to start TLS
TLS handshake complete: smtp.gmail.com

but the example has one line more:
221 2.0.0 closing connection l8sm10315047wmf.39 - gsmtp

so we miss the clossing conection message

Hi,

Tried to test SSL 2.0 with TlsSocket(compiled with mdTlsNative).
Don't think I'll find SSL 2.0 on anything used today but fun testing it if it works :).

Server: Windows XP SP2 x86.
Client: Windows 2003 SP2 x64 Internet Explorer 6 with TLS 1.0 and SSL 3.0 disabled(=only SSL 2.0 enabled).

Wireshark on Server shows that the Server gets a SSL 2.0 Client Hello but does not respond(only TCP ACK is sent back).

Testing the same as above but with SSL 3.0 enabled on Client works.
Also with TLS 1.0 enabled on Client Works.

Also tested Internet Explorer 6 on the Server to try to access TlsSocket on 127.0.0.1 but no response and I'm unable see anything local with WireShark.

Any hints on were to start to try to find the problem?

Suggestion:

to have more minimalistic samples. Projects attached.
Winsock-simple.zip

Also, don't you mind to clarify:

1. do I correctly stop the connection:

Private Sub cmdStop_Click()
    Dim i&
    For i = 0 To ctxServer.UBound
        If Not (ctxServer(i) Is Nothing) Then
            ctxServer(i).Close_
        End If
    Next

2. Comparing to Chat\Project1.vbp sample, where user control is not used, what is a difference? Is that mean, it is not multithreaded, so some side-effects are expected?

Thank you.

Hi everybody,

I'm trying to interface with a embedded hardware which seems to only use TLS 1.0(looking at the traffic with WireShark) for it's encrypted traffic.

The hardware presents 24 suites of ciphers according to WireShark.

I've used the sample TlsSocketTest with #Const ImplExotictCiphers = True.
Running debug on mdTlsThunks shows the following error:

Invalid protocol version (&H301).

VB6 on Windows XP x86 SP3.

Compiling the TlsSocketTest instead with native module and running binary on Windows 10 works.

What am I doing wrong?

Thanks.

Hi.
I've tried to use Http Request dll and faced trouble with SetClientCertificate. Default location for cert is "CURRENT_USER\MY" and i have valid cert there. I got the error (8009200b): Не удается найти сертификат и закрытый ключ для расшифровки ("Key not found" in eng, i think)

Standard WinHttp.WinHttpRequest.5.1 works fine with that cert.

When i try to use the wrong cert name - i got different error: 80072f89 - Предоставлен недопустимый сертификат ("certificate invalid"), so i assume i specified the path to the cert correctly.

Using
mdTlsThunks
cAsyncSocket
cHttpRequest
cTlsSocket
OS: XP POS Ready

I'm using an API at icecat.biz to download product specifications. It requires a username and password so I'm not sure how far you can get testing -- but sign up is free. Regardless, using cHttpRequest, the first 3389 to 3390 bytes are getting duplicated in the .ResponseText. It's showing up like this

</FeatureGroup>
  </Cate<?xml version="1.0" ... where the rest of this is correct and is the full XML document

If I search the .ResponseText for "<?xml version" after the first 15 bytes, I'm able to locate it and truncate the duplication, as a workaround.

Lastly, calls are failing frequently with no response at all, and no error thrown. I sent you a PM about this on vbforums.com with more data and a URL to test with login and password. Maybe 1 out of 5 calls works properly at least in the IDE. I'm not sure if something isn't getting closed, even though I'm setting the object to nothing after the call, or what exactly is happening.

Sorry to be so vague here but I wanted to alert you at least to the issue here in case you missed it at vbforums.com

Edit: One of your routines is throwing a subscript out of range during the times that the connection fails. It's difficult to nail down in what routine this is happening though, but it happens during the .Send call.

A little suggestion, - to add manifest sample in your project to remove a requirement for registration of winsock component, and subsequent requirement for run as admin.

Hi,

Have you planned to convert your code into a 64bit VBA version (Using PtrSafe and LongPtr).

Regards

Hi,
Why HTTPs protocol is not supported in download class?
best reguard

I'm rewriting an interface to a supplier's XML server. We currently test if their server is up by sending an empty payload via post. When we do this using WinHTTP, we get a "400 Bad Request" response which is what we expect. When using cHttpRequest, we get a "411 Length Required" response. It's not a big deal at all to test for either of those, but I thought you might want to know of the behavior difference. WinHTTP is probably setting the request header content-length to zero. I think the issue is here in your "Send" function, where it omits the header entirely -- but that's just a guess:

'--- prepare headers
        If Not .Stream Is Nothing Then
            SetRequestHeader HDR_CONTENT_LENGTH, IStream_GetSize(.Stream)
        End If

Not a big deal and technically what you have is probably correct, but I thought you might like to know of the difference, so as to make this as compatible as possible with existing WinHTTP behavior.

Maybe a patch to

'--- prepare headers
        If Not .Stream Is Nothing Then
            SetRequestHeader HDR_CONTENT_LENGTH, IStream_GetSize(.Stream)
        Else
            SetRequestHeader HDR_CONTENT_LENGTH, 0
        End if

EDIT: I made this patch locally and now the behavior is consistent with WinHTTP.

I'm encountering an issue while attempting to send a file over form data in VB6 using cHTTPRequest. I'm trying to replicate a cURL request that uploads a document to an API endpoint. The cURL command works as expected, but I'm having trouble achieving the same functionality

curl --location --request POST "https://api.mindee.net/v1/products/mindee/invoices/v4/predict" \
--header 'Authorization: Token fd1e97c821b43579a93b571d95aec10d' \
--form 'document=@"/D:/Bon de Livraison.pdf"'

Dim urlText As String
urlText = "https://api.mindee.net/v1/products/mindee/invoices/v4/predict"

With myRequest
    .SetRequestHeader "Authorization", "Token <API TOKEN>"
    .SetRequestHeader "Content-Type", "multipart/form-data"
    .Open "POST", urlText, False
    .Send "document=@" & Chr(34) & "/D:/Bon de Livraison.pdf" & Chr(34)
End With

I would appreciate any insights or suggestions on how to correctly send a file over form data in VB6 using cHTTPRequest. Thank you for your assistance!

Hello,

I have been looking for a TCP socket server/client implementation in VBA, but couldn't find any up to date.

However, stumbled upon this library but not sure how to implement this in VBA.

Could you share some guidance on how to make this (can it?) work on a VBA project?

Thank you.

I'm encountering an issue where a particular section of code is not returning a response when executed on Windows 10. The code snippet in question is as follows:

.Open_ "POST", "https://apiv1.spapharmainvest.com:5443/efa_sud/api/login", False
.SetRequestHeader "Authorization", "Basic Q0wwMDAwMjM6T0xyVENkcmE="
.SetRequestHeader "Cache-Control", "no-cache"
.SetRequestHeader "Content-Length", 0
.SetRequestHeader "Accept", "*/*"
.SetRequestHeader "Connection", "keep-alive"
.SetRequestHeader "Accept-Encoding", "gzip, deflate" ', br"
.SetRequestHeader "Accept-Language", "fr-FR,fr;q=0.8"
.Option_(WinHttpRequestOption_UserAgentString) = "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/50.0.2661.87 Safari/537.36"       
.Send

This code is intended to send a POST request to the specified API endpoint, but it fails to return a response when run on a Windows 10 environment. However, it seems to work as expected on other platforms.

Expected behavior:
The code should send a POST request to the specified API endpoint and receive a response, regardless of the operating system.

Actual behavior:
The code executes without errors, but it does not receive a response on Windows 10.

Steps to reproduce:

Run the provided code snippet on a Windows 10 environment.
Observe that no response is received.

Environment:
Operating System: Windows 10
Programming Language: VB6

Hi,

A user reported me a problem with check update function of my software using HttpRequest class, so I made a small app with just this :
cAsyncSocket.cls
cHttpRequest.cls
cTlsSocket.cls
mdTlsThunks.bas

Project with a Form, a Command button, a WebBrowser.
Code :

Private Sub Command1_Click()
    CheckUpdate ("https://mydomaind.com/checkupdate.php")
End Sub

Private Sub CheckUpdate(ByVal Url As String)
    
    Dim req As New cHttpRequest
    Dim resp As String
    
    With req
        .SetTimeouts 500, 500, 500, 500
        .Open_ "POST", Url, False
        .SetRequestHeader "Content-Type", "application/json"
        .Option_(WinHttpRequestOption_SslErrorIgnoreFlags) = 13056 '&H3300
        .Send
        If .ResponseText <> "" Then
            MsgBox .ResponseText
            WebBrowser1.navigate "about:blank"
            DoEvents
            WebBrowser1.document.Write .ResponseText
        End If
    End With
    Set req = Nothing

End Sub

When the user clicks on Command1 button, he get only Run-time error -2147012894 (80072ee2) .
The only info I found with google, was timeout problem, so I increased timeouts from 500 to 1000, but the user has tested with the same result.

Any idea ? :)

Thanks
Couin

I created an application on XP which is then tested (and running) on W7, W10 and W11. It sends and reads mails using pop3 and smtp. Now I wanted to convert to vbAsyncSocket to be able to use SSL and TLS1.2. However I found some differences:

• the events datarrival and sendprogress are not available
• the error events uses different parameters
  What can I do?

If necessary I can send you the sources of my classes. (comments are some times in german)

Steps to reproduce:

Open test\Winsock\Project1.vbp

Press Ctrl + F5.

pvTlsGetExtensionType() is missing due to been wrapped in conditional compilation.

BTW. Lot of thanks for this project !!!

cTlsSocket does not fire OnConnect when connected, however the underlying class cAsyncSocket does fire OnConnect. The encapsulating cTlsSocket isn't completely ready at that moment, so it can't be used as an indicator.

This is using mdTlsThunks. mdTlsNative doesn't appear to work at all. I will make another issue report for it

Hi,

if my application crashed, how can I forcibly close the port? Any tips...

.Close_ didn't help me.

cAsyncSocket.cls:
stack:
ctxServer(0).Bind LocalPort, "localhost" ->

If ws_bind(m_hSocket, uAddr, LenB(uAddr)) = SOCKET_ERROR Then

LastDllError:
Error: Usually only one use of the socket address (protocol / network address / port) is allowed

Very appreciate.

About security:

ctxServer_ConnectionRequest, requestID=676, RemoteHostIP=, RemotePort=0 63064,41

Is that a bug with RemoteHostIP / RemotePort, so we unable to verify the sender?

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