Enviar email no Visual Basic por Winsock 

Uma boa alternativa para enviar emails pelo Visual Basic é utilizar o componente Winsock. Trabalhando com o Winsock temos a liberdade de poder controlar passo a passo o envio da mensagem, podendo tratar todos os erros possíveis. A única coisa que precisamos é do modulo de encriptação em Base64, para encriptar o usuário e senha para a autenticação no servidor SMTP. E Inserir no nosso projeto o componente Microsoft Winsock Control.

Vou montar um simples exemplo, demonstrando o envio de um email.

Exemplo

Trabalhar com Winsock é muito simples, você se conecta ao seu servidor SMTP, e envia comandos para ele interpretar, que retornam resposta para você tratar. Os primeiros três caracteres da mensagem retornada formam um código, para você identificar o significado da mensagem retornada.

Vamos criar a interface do nosso exemplo:

1. Crie um formulário e o nomeie para frmPrincipal.

2. Insira 5 Labels, e defina a propriedade Caption para cada Label respectivamente: “Smtp”, “Remetente”, “Destinatário”, “Assunto”, “Mensagem”.

3. Insira 5 TextBoxs, e defina a propriedade Name para cada TextBox respectivamente: “txtSmtp”, “txtRemetente”, “txtDestinatario”, “txtAssunto”, “txtMensagem”.

4. Insira um CommandButton, e defina a propriedade Name para “cmdEnviarEmail” e a propriedade Caption para “Enviar Email”.

5. Insira um controle Winsock, e defina a propriedade Name para “winsockEmail”. Para inserir o componente Winsock na sua barra de controles, vá até o menu Project->Components na lista procure por Microsoft Winsock Control, marque a caixa de seleção, e confirme a alteração no botão OK.

Organize a interface da maneira que achar melhor.

No formulário frmPrincipal, crie as seguintes constantes:

Const cntConectando = 0

Const cntDesconectar = 1

Const cntConectado = 2

Const cntAutenticar = 3

Const cntAutenticarUsuario = 4

Const cntAutenticarSenha = 5

Const cntRemetente = 6

Const cntPara = 7

Const cntMensagem = 8

Const cntFinalizar = 9

Crie tambem as seguintes variaveis:

Dim strUsuarioSMTP As String

Dim strSenhaSMTP As String

Dim blnAutenicarSMTP As Boolean

Base 64

Agora vamos criar o modulo para encriptação do usuário e a senha enviados para o servidor SMTP, renomei-e para mdlBase64. E insira o código abaixo:

Public Function sBase64Decode(BASE64TEXT_IN As String) As String

Dim i As Long, sText As String, rc As Integer

Dim sFour As String, sThree As String

Dim sOut As String

sText = sRemoveWhitespace(BASE64TEXT_IN)

For i = 1 To Len(sText) Step 4

sFour = Mid$(sText, i, 4)

While Len(sFour) < 4: sFour = sFour & “=”: Wend

sThree = sDecode4(sFour)

If Len(sThree) = 3 Then

sOut = sOut & sThree

Else

rc = MsgBox(”Illegal Characters <” & sFour & “> found”, vbOKCancel, “PROGRAM ERROR”)

If rc = vbCancel Then Exit For

sOut = sOut & “???”

End If

Next i

sBase64Decode = sOut

End Function

Public Function sBase64Encode(TEXT_IN As String) As String

Dim i As Long, sText As String, sThree As String, sFour As String

Dim sOut As String, nLineLength As Integer

Dim nNulls As Integer

sText = TEXT_IN

For i = 1 To Len(sText) Step 3

sThree = Mid$(sText, i, 3)

nNulls = Len(sThree) Mod 3

If nNulls > 0 Then nNulls = 3 - nNulls

sThree = sThree & Left$(Chr$(0) & Chr$(0), nNulls)

sFour = sEncode3(sThree)

If nNulls > 0 Then

sFour = Left$(sFour, 4 - nNulls)

sFour = sFour & Left$(”==”, nNulls)

End If

sOut = sOut & sFour

nLineLength = nLineLength + 4

If nLineLength >= 64 Then

sOut = sOut & vbNewLine

nLineLength = 0

End If

Next i

sBase64Encode = sOut

End Function

Private Function nBase64Digit(VALUE_IN As Integer) As Byte

Dim Digit64 As Byte, n As Integer

Debug.Assert VALUE_IN >= 0 And VALUE_IN <= 63

n = VALUE_IN

Select Case n

Case Is <= 25: Digit64 = Asc(”A”) + n

Case Is <= 51: Digit64 = Asc(”a”) + (n - 26)

Case Is <= 61: Digit64 = Asc(”0″) + (n - 52)

Case 62: Digit64 = Asc(”+”)

Case 63: Digit64 = Asc(”/”)

Case Else

Digit64 = “?”

Debug.Assert False

End Select

nBase64Digit = Digit64

End Function

Private Function nBase64Value(ONEBYTE_IN As String) As Integer

Dim n As Integer

Select Case ONEBYTE_IN

Case “A” To “Z”: n = Asc(ONEBYTE_IN) - Asc(”A”)

Case “a” To “z”: n = 26 + Asc(ONEBYTE_IN) - Asc(”a”)

Case “0″ To “9″: n = 52 + Asc(ONEBYTE_IN) - Asc(”0″)

Case “+”: n = 62

Case “/”: n = 63

Case “=”: n = 0

Case Else

n = 255

End Select

nBase64Value = n

End Function

Private Function sDecode4(BASE64TEXT_IN As String) As String

Dim nBits As Long

Dim s1 As String, s2 As String, s3 As String, s4 As String

Dim t1 As String, t2 As String, t3 As String

Dim n1 As Byte, n2 As Byte, n3 As Byte, n4 As Byte

If Len(BASE64TEXT_IN) <> 4 Or Not IsBase64(BASE64TEXT_IN) Then

Debug.Assert False

sDecode4 = “”

Exit Function

End If

s1 = Mid$(BASE64TEXT_IN, 1, 1)

s2 = Mid$(BASE64TEXT_IN, 2, 1)

s3 = Mid$(BASE64TEXT_IN, 3, 1)

s4 = Mid$(BASE64TEXT_IN, 4, 1)

n1 = nBase64Value(s1)

n2 = nBase64Value(s2)

n3 = nBase64Value(s3)

n4 = nBase64Value(s4)

If n1 = 255 Or n2 = 255 Or n3 = 255 Or n4 = 255 Then

sDecode4 = “”

Exit Function

End If

nBits = nBits Or n4

nBits = nBits Or (n3 * 64&)

nBits = nBits Or (n2 * 64& * 64&)

nBits = nBits Or (n1 * 64& * 64& * 64&)

t3 = Chr$(nBits And 255)

t2 = Chr$((nBits \ 256) And 255)

t1 = Chr$((nBits \ 256 \ 256))

sDecode4 = t1 & t2 & t3

End Function

Private Function sEncode3(THREEBYTES_IN As String) As String

Dim s1 As String, s2 As String, s3 As String

Dim n1 As Byte, n2 As Byte, n3 As Byte

Dim nBits As Long

Dim t1 As Byte, t2 As Byte, t3 As Byte, t4 As Byte

Debug.Assert Len(THREEBYTES_IN) = 3

s1 = Mid$(THREEBYTES_IN, 1, 1)

s2 = Mid$(THREEBYTES_IN, 2, 1)

s3 = Mid$(THREEBYTES_IN, 3, 1)

n1 = Asc(s1)

n2 = Asc(s2)

n3 = Asc(s3)

nBits = nBits Or n3

nBits = nBits Or (n2 * 256&)

nBits = nBits Or (n1 * 256& * 256&)

t4 = nBase64Digit(nBits And 63)

t3 = nBase64Digit((nBits \ 64) And 63)

t2 = nBase64Digit((nBits \ 64 \ 64) And 63)

t1 = nBase64Digit((nBits \ 64 \ 64 \ 64) And 63)

sEncode3 = Chr$(t1) & Chr$(t2) & Chr$(t3) & Chr$(t4)

End Function

Public Function IsBase64(TEXT_IN As String, Optional MSGBOX_IN As Boolean = False) As Boolean

Dim i As Long, sText As String

If TEXT_IN = “” Then

IsBase64 = False

Exit Function

End If

sText = sRemoveWhitespace(TEXT_IN)

For i = 1 To Len(sText)

Select Case Mid$(sText, i, 1)

Case “A” To “Z”, “a” To “z”, “0″ To “9″, “+”, “/”, vbCr, vbLf

Case “=”

If i = Len(sText) - 1 Then

If Mid$(sText, i + 1, 1) = “=” Then

End If

ElseIf i = Len(sText) Then

Else

If MSGBOX_IN Then MsgBox “Text Error: Equal Sign not at end of text”, , “TRIM END OF TEXT”

IsBase64 = False

Exit Function

End If

Case Else

If MSGBOX_IN Then MsgBox “Non-base64 character <” _

& Mid$(TEXT_IN, i, 1) & “> found in base64″ _

& ” text”, , “ILLEGAL BASE64 BYTE”

IsBase64 = False

Exit Function

End Select

Next i

IsBase64 = True

End Function

Private Function sRemoveWhitespace(TEXT_IN As String) As String

Dim sText As String

sText = TEXT_IN

sText = Replace(sText, vbCr, “”)

sText = Replace(sText, vbLf, “”)

sText = Replace(sText, vbTab, “”)

sText = Replace(sText, ” “, “”)

sRemoveWhitespace = sText

End Function

Winsock

Vamos criar o código para tratar os eventos do winsockEmail, no evento DataArrival vamos inserir este código:

Private Sub winsockEmail_DataArrival(ByVal bytesTotal As Long)

Dim strDadosRecebidos As String

Dim strStatusCodigo As String

Dim strEmailHTML As String

Dim strEmailMensagem As String

‘* Verifica se o winsock foi conectado
If Trim(winsockEmail.Tag) <> “” Then _

winsockEmail.GetData strDadosRecebidos

‘* Define o codigo do status
strStatusCodigo = Left(strDadosRecebidos, 3)

Select Case strStatusCodigo

‘* Caso tenha retornado um status valido
Case “250″, “220″, “354″, “221″, “334″, “235″:

‘* Caso nao tenha retornado um resultado valido
Case Else:

MsgBox “Erro: ” & strDadosRecebidos, vbCritical

‘* Define o status do winsock
winsockEmail.Tag = cntDesconectar

‘* Define o codigo do status
strStatusCodigo = Mid(strDadosRecebidos, 4)

End Select

Select Case winsockEmail.Tag

‘* Caso esteja conectando
Case cntConectando:

‘* Verifica se deve autenticar o smtp
If blnAutenicarSMTP = True Then

‘* Define o status para autenticar
winsockEmail.Tag = cntAutenticar

Else

‘* Define o status para conectado
winsockEmail.Tag = cntConectado

End If

‘* Envia o IP da maquina
winsockEmail.SendData “ehlo ” & winsockEmail.LocalIP & vbCrLf

‘* Caso esteja autenticando
Case cntAutenticar:

‘* Envia pedido de autenticacao
winsockEmail.SendData “auth login” & vbCrLf

‘* Define o status para autenticar o usuario
winsockEmail.Tag = cntAutenticarUsuario

‘* Caso esteja autenticando o usuario
Case cntAutenticarUsuario:

‘* Codifica o usuario do smtp e envia para o servidor SMTP
winsockEmail.SendData sBase64Encode(Trim(strUsuarioSMTP)) & vbCrLf

‘* Define o status para autenticar senha
winsockEmail.Tag = cntAutenticarSenha

‘* Caso esteja autenticando a senha
Case cntAutenticarSenha:

‘* Codifica a senha e envia o servidor SMTP
winsockEmail.SendData sBase64Encode(Trim(strSenhaSMTP)) & vbCrLf

‘* Define o status como conectado
winsockEmail.Tag = cntConectado

‘* Caso esteja conectado
Case cntConectado:

‘* Envia para o servidor SMTP o email do remetente
winsockEmail.SendData “mail from:<” & Trim(txtRemetente.Text) & “>” & vbCrLf

‘* Define o status como remetente
winsockEmail.Tag = cntRemetente

‘* Case esteja com o status remetente
Case cntRemetente:

‘* Envia para o servidor SMTP quem ira receber a mensagem
winsockEmail.SendData “rcpt to:<” & Trim(txtDestinatario.Text) & “>” & vbCrLf

‘* Define o status para quem ira receber a mensagem
winsockEmail.Tag = cntPara

‘* Caso esteja enviado quem ira receber a mensagem
Case cntPara:

‘* Enviar para o servidor SMTP o comando data
winsockEmail.SendData “data” & vbCrLf

‘* Define o status para enviar a mensagem
winsockEmail.Tag = cntMensagem

‘* Caso tenha que enviar a mensagem
Case cntMensagem:

‘* Monta o cabecalho do email
strEmailHTML = “subject:” & txtAssunto.Text & vbCrLf & _
“from:” & txtRemetente.Text & vbCrLf & _
“to:” & txtDestinatario.Text & vbCrLf & _
“MIME-Version: 1.0″ & vbCrLf & _
“Content-type: text/html; charset=iso-8859-1″ & vbCrLf

‘* Monta a mensagem
strEmailMensagem = “<body>” & vbCrLf & vbCrLf & Trim(txtMensagem.Text) & vbCrLf & vbCrLf & “</body>”

‘* Troca . entre quebra de linhas por ..
While InStr(strEmailMensagem, vbCrLf & “.” & vbCrLf) <> 0

strEmailMensagem = Replace(strEmailMensagem, vbCrLf & “.” & vbCrLf, vbCrLf & “..” & vbCrLf)

Wend

‘* Envia para o servidor SMTP o texto do email
winsockEmail.SendData strEmailHTML & strEmailMensagem & vbCrLf & “.” & vbCrLf

‘* Define o status para finalizar a conexao
winsockEmail.Tag = cntFinalizar

‘* Caso tenha que finalizar a conexao
Case cntFinalizar:

MsgBox “Mensagem enviada!”

‘* Envia para o servidor SMTP a saida
winsockEmail.SendData “quit” & vbCrLf

‘* Define o status para desconectar o winsock
winsockEmail.Tag = cntDesconectar

‘* Caso queira desconectar o winsock
Case cntDesconectar:

‘* Fecha o winsock
winsockEmail.Close

‘* Limpa o status do winsock
winsockEmail.Tag = “”

End Select

End Sub

No evento Connect, vamos inserir o seguinte código:

Private Sub winsockEmail_Connect()

‘* Define o status do winsock
winsockEmail.Tag = cntConectando

End Sub

Conectar e Enviar

Agora vamos criar o evento click do botão para enviar o email, insira o seguinte código:

Private Sub cmdEnviarEmail_Click()

‘* Pergunta ao usuario se quer autenticar no servidor smtp
If MsgBox(”Autenticar no servidor SMTP?”, vbYesNo, “Autenticação”) = vbYes Then

blnAutenicarSMTP = True

‘* Abre a caixa para o usuario digitar o usuario do smtp
strUsuarioSMTP = InputBox(”Digite o usuario do servidor smtp”)

‘* Abre a caixa para o usuario digitar a senha do smtp
strSenhaSMTP = InputBox(”Digite a senha do servidor smtp”)

Else

‘* Definir e limpar variaveis para nao autenticar
blnAutenicarSMTP = False

strUsuarioSMTP = “”

strSenhaSMTP = “”

End If

‘* Conectar ao servidor SMTP via winsock, no ip apontado por txtSMTP e a porta 25
winsockEmail.Connect txtSmtp.Text, 25

End Sub

Testando o exemplo

Apos preencher os dados, clique no botão de enviar mensagem. Uma MsgBox vai aparecer perguntado se quer você quer autenticar no servidor SMTP. Caso queira, digite o usuario e a senha do seu servidor SMPT.

O winsockEmail conecta-se ao servidor SMTP apontado por txtSmtp.Text, na porta 25:

‘* Conectar ao servidor SMTP via Winsock, no ip apontado por txtSMTP e a porta 25
winsockEmail.Connect txtSmtp.Text, 25

As respostas do servidor SMTP são recebidas no evento DataArrival. Onde definimos na string strStatusCodigo o código de identificação da mensagem, e verificamos se o codigo retornado é valido:

‘* Define o codigo do status
strStatusCodigo = Left(strDadosRecebidos, 3)

Select Case strStatusCodigo

‘* Caso tenha retornado um status valido
Case “250″, “220″, “354″, “221″, “334″, “235″:

‘* Caso nao tenha retornado um resultado valido
Case Else:

MsgBox “Erro: ” & strDadosRecebidos, vbCritical

‘* Define o status do winsock
winsockEmail.Tag = cntDesconectar

‘* Define o codigo do status
strStatusCodigo = Mid(strDadosRecebidos, 4)

End Select

Agora verificamos o status do winsock, caso ele esteja conectando verificamos se devemos executar a autenticação no servidor SMTP, ou conectar sem autenticar:

Select Case winsockEmail.Tag

‘* Caso esteja conectando
Case cntConectando:

‘* Verifica se deve autenticar o smtp
If blnAutenicarSMTP = True Then

‘* Define o status para autenticar
winsockEmail.Tag = cntAutenticar

Else

‘* Define o status para conectado
winsockEmail.Tag = cntConectado

End If

‘* Envia o IP da maquina
winsockEmail.SendData “ehlo ” & winsockEmail.LocalIP & vbCrLf

Codificamos e enviamos o usuario e a senha apontados por “strUsuarioSMTP” e “strSenhaSMTP”, respectivamente:

‘* Caso esteja autenticando
Case cntAutenticar:

‘* Envia pedido de autenticacao
winsockEmail.SendData “auth login” & vbCrLf

‘* Define o status para autenticar o usuario
winsockEmail.Tag = cntAutenticarUsuario

‘* Caso esteja autenticando o usuario
Case cntAutenticarUsuario:

‘* Codifica o usuario do smtp e envia para o servidor SMTP
winsockEmail.SendData sBase64Encode(Trim(strUsuarioSMTP)) & vbCrLf

‘* Define o status para autenticar senha
winsockEmail.Tag = cntAutenticarSenha

‘* Caso esteja autenticando a senha
Case cntAutenticarSenha:

‘* Codifica a senha e envia o servidor SMTP
winsockEmail.SendData sBase64Encode(Trim(strSenhaSMTP)) & vbCrLf

‘* Define o status como conectado
winsockEmail.Tag = cntConectado

Após confirmar a conexão envia os dados do remetente e destinatários. Após envia o comando data, para começar a enviar a mensagem:

‘* Caso esteja conectado
Case cntConectado:

‘* Envia para o servidor SMTP o email do remetente
winsockEmail.SendData “mail from:<” & Trim(txtRemetente.Text) & “>” & vbCrLf

‘* Define o status como remetente
winsockEmail.Tag = cntRemetente

‘* Case esteja com o status remetente
Case cntRemetente:

‘* Envia para o servidor SMTP quem ira receber a mensagem
winsockEmail.SendData “rcpt to:<” & Trim(txtDestinatario.Text) & “>” & vbCrLf

‘* Define o status para quem ira receber a mensagem
winsockEmail.Tag = cntPara

‘* Caso esteja enviado quem ira receber a mensagem
Case cntPara:

‘* Enviar para o servidor SMTP o comando data
winsockEmail.SendData “data” & vbCrLf

‘* Define o status para enviar a mensagem
winsockEmail.Tag = cntMensagem

Monta a estrutura do html que será enviado. Contendo um cabeçalho com alguns dados do email como assunto, remetente, destinatário. E a mensagem em html. Após, envia a mensagem pelo winsockEmail:

‘* Caso tenha que enviar a mensagem
Case cntMensagem:

‘* Monta o cabecalho do email
strEmailHTML = “subject:” & txtAssunto.Text & vbCrLf & _
“from:” & txtRemetente.Text & vbCrLf & _
“to:” & txtDestinatario.Text & vbCrLf & _
“MIME-Version: 1.0″ & vbCrLf & _
“Content-type: text/html; charset=iso-8859-1″ & vbCrLf

‘* Monta a mensagem
strEmailMensagem = “<body>” & vbCrLf & vbCrLf & Trim(txtMensagem.Text) & vbCrLf & vbCrLf & “</body>”

‘* Troca . entre quebra de linhas por ..
While InStr(strEmailMensagem, vbCrLf & “.” & vbCrLf) <> 0

strEmailMensagem = Replace(strEmailMensagem, vbCrLf & “.” & vbCrLf, vbCrLf & “..” & vbCrLf)

Wend

‘* Envia para o servidor SMTP o texto do email
winsockEmail.SendData strEmailHTML & strEmailMensagem & vbCrLf & “.” & vbCrLf

‘* Define o status para finalizar a conexao
winsockEmail.Tag = cntFinalizar

Caso tenha finalizado, mostra uma mensagem de concluído e fecha winsockEmail:

‘* Caso tenha que finalizar a conexao
Case cntFinalizar:

MsgBox “Mensagem enviada!”

‘* Envia para o servidor SMTP a saida
winsockEmail.SendData “quit” & vbCrLf

‘* Define o status para desconectar o winsock
winsockEmail.Tag = cntDesconectar

‘* Caso queira desconectar o winsock
Case cntDesconectar:

‘* Fecha o winsock
winsockEmail.Close

‘* Limpa o status do winsock
winsockEmail.Tag = “”

Download do exemplo

O link para download do exemplo:

http://www.fdweb.com.br/downloads/enviaremailvisualbasic.zip

Confira ofertas de: DVD, filmes, celular, notebook, livros, jogos, Wii, PS3, MP4