ESTOU ENVIANDO EMAIL USANDO O WINSOCK SÓ QUE NÃO CONSIGO COLOCAR "DE " E NEM O " PARA ", NO EMAIL, AI É TRATADO SOMO SPAM E DEMORA PARA CHEGAR, POR FAVOR ALGUEM PODE ME AJUDAR ?
ABAIXO O CÓDIGO :
[«C»]
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim strData As String
Dim MsgTexto As String
Dim Msg As String
Dim Status As String
Dim Erro As Boolean
If Trim(Winsock1.Tag) <> "" Then
Winsock1.GetData strData
Status = Left(strData, 3)
'Verifica de o servidor retornou alguma msg de erro
Select Case Status
Case "250", "220", "354", "221", "334", "235": Erro = False
Case Else:
Erro = True
Winsock1.Tag = "fechar"
Status = Mid(strData, 4)
End Select
Select Case Winsock1.Tag
Case "conectado":
If chkAuth Then
Msg = "ehlo " & Winsock1.LocalIP & vbCrLf
Winsock1.Tag = "autenticar"
Else
Msg = "helo " & Winsock1.LocalIP & vbCrLf
Winsock1.Tag = "conectou"
End If
Winsock1.SendData Msg
stbConexao.Panels(1).Text = "Conectado."
Case "autenticar":
Msg = "auth login" & vbCrLf
Winsock1.SendData Msg
Winsock1.Tag = "autenticar_usuario"
Case "autenticar_usuario":
Msg = sBase64Encode(txtLogin.Text) & vbCrLf
Winsock1.SendData Msg
Winsock1.Tag = "autenticar_senha"
Case "autenticar_senha":
Msg = sBase64Encode(txtSenha.Text) & vbCrLf
Winsock1.SendData Msg
Winsock1.Tag = "conectou"
Case "conectou":
stbConexao.Panels(1).Text = "Enviando..."
Winsock1.SendData "mail from:<" & TxtToEmailAddress.Text & ">" & vbCrLf
Winsock1.Tag = "from"
Case "from":
Winsock1.SendData "rcpt to:<" & TxtFromEmailAddress.Text & ">" & vbCrLf
Winsock1.Tag = "to"
Case "to":
Winsock1.SendData "data" & vbCrLf
Winsock1.Tag = "data"
Case "data":
'A sequencia "." e quebra de linha deve ser substituida por ".." e quebra de linha
'para evitar que o servidor entenda fim de email antes do fim do texto
txtMsg.Text = MsgMessage
MsgTexto = txtMsg.Text & vbCrLf
While InStr(MsgTexto, vbCrLf & "." & vbCrLf) <> 0
MsgTexto = Replace(MsgTexto, vbCrLf & "." & vbCrLf, vbCrLf & ".." & vbCrLf)
Wend
Msg = "subject: " & TxtEmailSubject.Text & vbCrLf
Msg = Msg & "MIME-Version: 1.0" & vbCrLf & "Content-type: text/html; charset=iso-8859-1" & vbCrLf
Msg = Msg & MsgTexto & vbCrLf & "." & vbCrLf
Winsock1.SendData Msg
Winsock1.Tag = "fim"
Case "fim":
stbConexao.Panels(1).Text = "Desconectando..."
Winsock1.SendData "quit" & vbCrLf
Winsock1.Tag = "fechar"
Case "fechar":
If Not Erro Then
stbConexao.Panels(1).Text = "Enviado com sucesso!"
Else
stbConexao.Panels(1).Text = "Erro ao enviar email!"
MsgBox Status, vbCritical, "Erro"
End If
Winsock1.Close
Winsock1.Tag = ""
End Select
End If
End Sub
POR FAVOR URGENTE
