[RESOLVED] VB6 QUESTION: CDO Email Guide and STARTTLS

[yereverluvinuncleber]

My program wants to email users on an interval. I have implemented email from VB6 using the MS CDO libraries and found a lot of posts and pages regarding configuring it for various SMTP settings, including STARTTLS. Most of the information was lacking but I have found no better guide than this one here:

https://codekabinett.com/rdumps.php?...access-vba-cdo

Of course I only found that guide after I had implemented my code. My program is all working and I can send emails successfully using Microsoft's servers via port 25 using SSL - but that post confirmed what I had suspected, ie. that STARTTLS is not supported.



My question is: Apart from calling a powershell script (not much use in older versions of Windows) is there a better method of successfully contacting SMTP servers using STARTTLS from within VB6?

I have looked at some of the winsock code that is available here but I haven't been able to get that to work and I don't have the confidence to build an email app this way. I have also discovered the OstroSoft SMTP Component that has a licence that allows unlimited usage for developing non-commercial applications. It seems to be the one with the most potential, being free - but I have not yet tested it.

http://ostrosoft.com/ossmtp.aspx

So, you chaps, any ideas as to what is the current best method for implementing email via SMTP and STARTTLS using VB6?

PS. Of course I have seen the commercial 3rd party SMTP libraries and those that are very expensive are not within my reach at least not for this app.

[yereverluvinuncleber]

Crikey, I have never experienced such a silence on one of my questions. It must either be the Christmas holiday or the problem is a tricky one to resolve. Initially I was surprised but I assume that the complexities of a TLS connection are so great that no-one has yet come up with a solution using VB6 code.

Do I have to write an email handler in VB.NET and then pass the task to that?

[wqweto]

. . . but I assume that the complexities of a TLS connection are so great that no-one has yet come up with a solution using VB6 code.

It's true TLS handling can be tricky but on top of that you'll need a full blown SMTP client which might be even trickier.

Currently looking at urlproxyserver configuration field and wondering if CDO can be used to connect ot a localhost proxy which injects STARTTLS on the server connection leaving CDO oblivious it's accessing the server over TLS.

This looks doable although nowhere is the kind of proxy documented. Could be some kind of CONNECT capable http/https proxy that is needed here or it could be SOCKS4/5 proxy -- no idea (yet).

cheers,
</wqw>

[yereverluvinuncleber]

Wqweto, is this something you are looking into for your own program coincidentally or a shortcoming of CDO that you have been aware of for a while and wanted to fix?

I have heard that all (?) that is required is a STARTTLS command to be issued, it would seem strange that CDO has been abandoned by MS when it is so close to doing what is required.

[wqweto]

Here is an MITM SMTP proxy I just cobbled together that injects a STARTTLS right after client's EHLO

Option Explicit
DefObj A-Z
'Private Const MODULE_NAME As String = "cSmtpProxy"

'=========================================================================
' Public events
'=========================================================================

Event RecvFromClient(Data() As Byte)
Event RecvFromServer(Data() As Byte)

'=========================================================================
' Constants and member variables
'=========================================================================

Private m_sServerAddress        As String
Private m_lServerPort           As Long
Private WithEvents m_oListen    As cTlsSocket
Private WithEvents m_oClient    As cTlsSocket
Private WithEvents m_oServer    As cTlsSocket

'=========================================================================
' Properties
'=========================================================================

Public Property Get ServerAddress() As String
    ServerAddress = m_sServerAddress
End Property

Public Property Get ServerSocket() As cTlsSocket
    Set ServerSocket = m_oServer
End Property

Public Property Get ClientSocket() As cTlsSocket
    Set ClientSocket = m_oClient
End Property

'=========================================================================
' Methods
'=========================================================================

Public Function Init(sServerAddress As String, ByVal lServerPort As Long, ByVal lLocalPort As Long, Optional sLocalAddress As String) As Boolean
    m_sServerAddress = sServerAddress
    m_lServerPort = lServerPort
    Set m_oListen = New cTlsSocket
    If Not m_oListen.Create(lLocalPort, SocketAddress:=sLocalAddress) Then
        GoTo QH
    End If
    If Not m_oListen.Listen() Then
        GoTo QH
    End If
    '--- success
    Init = True
QH:
End Function

Private Sub pvInjectStartTls(sText As String)
    If Left$(sText, 5) <> "EHLO " Then
        GoTo QH
    End If
    If Not m_oServer.SyncSendText(sText) Then
        GoTo QH
    End If
    sText = m_oServer.SyncReceiveText()
    If LenB(sText) = 0 Then
        GoTo QH
    End If
    sText = "STARTTLS" & vbCrLf
    If Not m_oServer.SyncSendText(sText) Then
        GoTo QH
    End If
    sText = m_oServer.SyncReceiveText()
    If LenB(sText) = 0 Then
        GoTo QH
    End If
    If Not m_oServer.SyncStartTls(m_sServerAddress) Then
        GoTo QH
    End If
QH:
End Sub

'=========================================================================
' Socket events
'=========================================================================

Private Sub m_oListen_OnAccept()
    Set m_oServer = New cTlsSocket
    If Not m_oServer.Connect(m_sServerAddress, m_lServerPort, UseTls:=False) Then
        Set m_oServer = Nothing
        GoTo QH
    End If
    Set m_oClient = New cTlsSocket
    m_oListen.Accept m_oClient, UseTls:=False
QH:
End Sub

Private Sub m_oServer_OnReceive()
    Dim baBuffer()      As Byte
    
    If m_oServer.ReceiveArray(baBuffer) Then
        RaiseEvent RecvFromServer(baBuffer)
        m_oClient.SendArray baBuffer
    End If
End Sub
   
Private Sub m_oClient_OnReceive()
    Dim baBuffer()      As Byte
    
    If m_oClient.ReceiveArray(baBuffer) Then
        pvInjectStartTls StrConv(baBuffer, vbUnicode)
        RaiseEvent RecvFromClient(baBuffer)
        m_oServer.SendArray baBuffer
    End If
End Sub

Private Sub m_oClient_OnClose()
    m_oServer.Close_
End Sub

This is how to start the SMTP proxy on localhost port 10025

Option Explicit

Private m_oProxy As cSmtpProxy

Private Sub Form_Load()
    Set m_oProxy = New cSmtpProxy
    If Not m_oProxy.Init("smtp.gmail.com", 25, 10025) Then
        GoTo QH
    End If
QH:
End Sub

This is how to use CDO to send mail using the localhost SMTP proxy on port 10025

Private Sub pvSendMail()
    Const CONFIG As String = "http://schemas.microsoft.com/cdo/configuration/"
    
    Dim oMsg As Object
    Set oMsg = CreateObject("CDO.message")
    With oMsg.Configuration.Fields
        .Item(CONFIG & "sendusing") = 2
        .Item(CONFIG & "smtpserver") = "127.0.0.1"
        .Item(CONFIG & "smtpserverport") = 10025
        .Item(CONFIG & "smtpauthenticate") = 1
        .Item(CONFIG & "sendusername") = "***@gmail.com"
        .Item(CONFIG & "sendpassword") = "***"
        .Update
    End With
    With oMsg
        .To = "***@saas.bg"
        .From = "***@gmail.com"
        .Subject = "the email subject"
        .TextBody = "the full message body goes here. you may want to create a variable to hold the text"
        .Send
    End With
End Sub

The sample code above uses STARTTLS on smtp.gmail.com port 25. Without the proxy CDO fails on plaintext port 25 because gmail requires STARTTLS secure connection before sending auth and CDO does not work with STARTTLS natively (no matter all the false claims on the internet).

You'll need to add TLS support in your project from VbAsyncSocket repo e.g. cAsyncSocket, cTlsSocket and mdTlsNative modules.

cheers,
</wqw>

[yereverluvinuncleber]

You just cobbled that together? I don't know what to say. I'll be back in a week when I've attempted to pull that into my proj. Thankyou.

[wqweto]

You just cobbled that together? I don't know what to say. I'll be back in a week when I've attempted to pull that into my proj. Thankyou.

It's ~100 LOC and is *the* only solution for doing STARTTLS with CDO so this topic will become popular -- I just made sure the code does not look like a hot mess.

cheers,
<>/wqw>

[yereverluvinuncleber]

I may be doing this wrong but this is what I have achieved so far:

I created a small application called mitmProxy with your code above - and the module mdTlsNative and class modules, cAsyncSocket, cTlsSocket. It runs no problem at all and I can see by running:

 netstat - an | more

- that it is listening on port 10025.

So, I believe I have a working mitm program operating from behind a standard VB form sitting on the desktop. I have made no changes to your code.

My own program' s CDO config was amended to talk to port 10025 and the mimtProxy appears to respond to the data coming though that port. The mimtProxy program has been amended to show a text box that tells me what the program is currently doing by reporting the routine it is currently running. The CDO config in my program passes the username and password for a gmail SMTP server using details that have been tested and which operate successfully in normal SSL mode on port 465 when using Thunderbird as a client, so I know the test account is working.

However, In the line that initiates the mimtProxy it does not matter if I use port 25 as suggested or another port, it seems to acknowledge receipt of the connection and handles it, then shortly afterward an error is generated.

Error -2147220973 (The transport failed to connect to the server.
) in procedure SendEmail of Form FireCallPrefs

Just describing what I have done so far so that if I have made any glaring mistakes it should be obvious.

I am currently doing some digging to see if I can discern where the problem lies.

[wqweto]

Here is a full working sample project: SmtpProxyTest.zip

cheers,
</wqw>

[yereverluvinuncleber]

Yes, it just worked. Mine didn't, yours did immediately. I will look into why and test mine and fix.

[yokesee]

it works fine with outlook but with gmail I had problems.
good job wqweto

[wqweto]

it works fine with outlook but with gmail I had problems.

You might need to setup an App Password to access gmail's SMTP servers with a 2FA enabled google account.

This is what I used to test the proxy here as I do have 2FA enabled through Google Authenticator on my phone.

< 220 smtp.gmail.com ESMTP z18sm2746829lfd.8 - gsmtp
> EHLO wqwpc
< 250-smtp.gmail.com at your service, [77.238.66.165]
  250-SIZE 35882577
  250-8BITMIME
  250-AUTH LOGIN PLAIN XOAUTH2 PLAIN-CLIENTTOKEN OAUTHBEARER XOAUTH
  250-ENHANCEDSTATUSCODES
  250-PIPELINING
  250-CHUNKING
  250 SMTPUTF8
> AUTH LOGIN
< 334 VXNlcm5hbWU6
> ****
< 334 UGFzc3dvcmQ6
> ****
< 235 2.7.0 Accepted
> MAIL FROM: <wqweto@gmail.com>
< 250 2.1.0 OK z18sm2746829lfd.8 - gsmtp
> RCPT TO: <***@saas.bg>
< 250 2.1.5 OK z18sm2746829lfd.8 - gsmtp
> DATA
< 354  Go ahead z18sm2746829lfd.8 - gsmtp
> thread-index: Adf+OxGXt+zb0tqDS0OHjRMIJ+6QhQ==
  Thread-Topic: subj 5
  From: <wqweto@gmail.com>
  To: <***@saas.bg>
  Subject: subj 5
  Date: Fri, 31 Dec 2021 13:39:28 +0200
  Message-ID: <C38291BECED849FD83FEB49D22A90699@ucs.local>
  MIME-Version: 1.0
  Content-Type: text/plain
  Content-Transfer-Encoding: 7bit
  X-Mailer: Microsoft CDO for Windows 2000
  Content-Class: urn:content-classes:message
  Importance: normal
  Priority: normal
  X-MimeOLE: Produced By Microsoft MimeOLE
  
  proba 5
  .
< 250 2.0.0 OK  1640950769 z18sm2746829lfd.8 - gsmtp
> QUIT
< 221 2.0.0 closing connection z18sm2746829lfd.8 - gsmtp

cheers,
</wqw>

[yokesee]

works perfectly thank you very much

[ChrisE]

this works for me, I use Win10 with Outlook (Office2010)

Private Sub Command1_Click()
Dim objMessage As CDO.Message
Dim objConf As CDO.Configuration
Dim strBody As String
Const cdoSendUsingPickup = 1 'Send message using the local SMTP service pickup directory.
Const cdoSendUsingPort = 2 'Send the message using the network (SMTP over the network).

Const cdoAnonymous = 0 'Do not authenticate
Const cdoBasic = 1 'basic (clear-text) authentication
Const cdoNTLM = 2 'NTLM

Set objMessage = CreateObject("CDO.Message")
Set objConf = CreateObject("CDO.Configuration")

'==This section provides the configuration information for the remote SMTP server.

objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

'Name or IP of Remote SMTP Server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "securesmtp.t-online.de"

'Type of authentication, NONE, Basic (Base64 encoded), NTLM
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic

'Your UserID on the SMTP server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = "myEmail@t-online.de"

'Your password on the SMTP server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "myPassword"

'Server port (typically 25)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465

'Use SSL for the connection (False or True)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True

'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10

'objMessage.Configuration.Fields.Update

strBody = "This is a sample message." & vbCrLf
strBody = strBody & "It was sent using CDO." & vbCrLf


objMessage.To = "someEmail@t-online.de"
objMessage.From = "myEmail@t-online.de"
objMessage.Subject = "This is a CDO test message"
objMessage.TextBody = strBody
'add Attachment
objMessage.AddAttachment "D:\TestFolder\Data1.xml"
objMessage.Configuration.Fields.Update
objConf.Fields.Update

'==End remote SMTP server configuration section==

objMessage.Send
Set objMessage = Nothing
End Sub

[wqweto]

@ChrisE: Using smtpusessl=True setting instructs CDO to directly start TLS secure session on connection initiation.

The STARTTLS approach is different (legacy) and allows for initial plaintext connection which is later negotiated/upgraded to TLS secure session.

CDO does not support STARTTLS negotiation and that's what this proxy exactly tries to fix by injecting STARTTLS negotiation in SMTP traffic.

cheers,
</wqw>

[yereverluvinuncleber]

[yereverluvinuncleber]

Wqweto's code is extremely useful for implementing STARTTLS using CDO and VB6.

[joeycat77]

Here is a full working sample project: SmtpProxyTest.zip

cheers,
</wqw>

Can we .AddAttachment ?

[wqweto]

Can we .AddAttachment ?

Did you try to? Post here if it’s not working.

[joeycat77]

Did you try to? Post here if it’s not working.

Yes sir, I tried and it gave me an error. I can post the exact message later for you. Thanks for your help. Everything works fine when I send on 465, just need to include an attachment.

Joe

[wqweto]

Can you send the same attachment file through gmail’s web interface? Is the file too big or flagged as virus?

[joeycat77]

It's a small PDF. I have been sending through CDO forever without issue. Then our domain went and made us upgrade to starttls :/ I can't 587 to save my life, even with your code but your code will let me send 465 which is just fine. But can't attach.

[wqweto]

I just tested .AddAttachment with a 40KB PDF file and there is no problem with the proxy on my machine using smtp.gmail.com for outgoing server.

Can you send the PDF file which is failing with you using Outlook or other mail application with support for STARTTLS? It could be blocked by the SMTP server you are talking to.

cheers,
</wqw>

[joeycat77]

Ok thanks again. I'll try later tonight and get back to you. I appreciate the help.

[joeycat77]

Runtime error 438 object doesn't support this property or method.
oMsg.addattachment = "c:\test.pdf"

[joeycat77]

And I'm dumb. It's addattatchment ("file"), not =

Sorry for your trouble and ty so much for the code.

Joe

[jbutnervb]

Here is a full working sample project: SmtpProxyTest.zip

cheers,
</wqw>

Would love to have your working example but unfortunately the link is dead.

[wqweto]

Would love to have your working example but unfortunately the link is dead.

Works for me here (and everywhere).

Btw, you can use https://archive.org to snapshot it for you and then immediately download it from their servers.

I mean when your internet connection is filtered/crappy just use common sense.

cheers,
</wqw>

[fafalone]

That's weird... I tried to grab it earlier and also got a 404. Tried to grab it through archive.org too with no luck, then searched for the filename also without luck. But just now it worked.

Edit: Hah, I'm not crazy, I had an open tab still showing as of a few hours ago it wasn't on archive.org, and you can see the tabs where I was poking around the site looking for an updated link in the top right.

https://imgur.com/mg3Pcon

[jbutnervb]

Works for me here (and everywhere).

Btw, you can use https://archive.org to snapshot it for you and then immediately download it from their servers.

I mean when your internet connection is filtered/crappy just use common sense.

cheers,
</wqw>

I was finally able to download this once I allowed the site in Malwarebytes. For some reason Malwarebytes did not like it.

[fafalone]

There's no binaries in it, so not sure why MWB would be acting up on it.