(Solucionado) Winsock Vb6

[Rafa Mendonça]

Buenas!!

Estou desenvolvendo um aplicativo em vb6 que dispara um e-mail utilizando o winsock, porém é necessário que este aplicativo anexe um arquivo junto ao e-mail.

Não sei se é possível através do winsock...gostaria que o programa fizesse isso sem ajuda de terceiros(Outlook por exemplo). Se alguém tiver alguma sugestão agradeço.

Segue código que estou utilizando:

VerificaResposta

If Not Mid(Dados, 1, 3) = "220" Then
  MsgBox "Ocorreu o seguinte erro no servidor : " & vbCrLf + Dados
  Winsock1.Close
  Exit Sub
End If

Winsock1.SendData ("HELO " & "delamano.com.br" & Chr(13) + Chr(10))

VerificaResposta

If Not Mid(Dados, 1, 3) = "250" Then
  MsgBox "Ocorreu o seguinte erro no servidor : " & vbCrLf + Dados
  Winsock1.Close
  Exit Sub
End If

Winsock1.SendData ("AUTH LOGIN " & vbCrLf)

VerificaResposta

If Not Mid(Dados, 1, 3) = "334" Then
  MsgBox "Ocorreu o seguinte erro no servidor : " & vbCrLf + Dados
  Winsock1.Close
  Exit Sub
End If

Winsock1.SendData ("cm9kcmlnby5iYXJyb3NAZGVsYW1hbm8uY29tLmJy" & vbCrLf)

VerificaResposta

If Not Mid(Dados, 1, 3) = "334" Then
  MsgBox "Ocorreu o seguinte erro no servidor : " & vbCrLf + Dados
  Winsock1.Close
  Exit Sub
End If

Winsock1.SendData ("ZGVsYTIwMDk=" & vbCrLf)

VerificaResposta

If Not Mid(Dados, 1, 3) = "235" Then
  MsgBox "Ocorreu o seguinte erro no servidor : " & vbCrLf + Dados
  Winsock1.Close
  Exit Sub
End If

Winsock1.SendData ("MAIL FROM: <" & Remetente & ">" & vbCrLf)

VerificaResposta

If Not Mid(Dados, 1, 3) = "250" Then
  MsgBox "Ocorreu o seguinte erro no servidor : " & vbCrLf + Dados
  Winsock1.Close
  Exit Sub
End If

Winsock1.SendData ("RCPT TO: <" & Destino & ">" & vbCrLf)

VerificaResposta

If Not Mid(Dados, 1, 3) = "250" Then
  MsgBox "Ocorreu o seguinte erro no servidor : " & vbCrLf + Dados
  Winsock1.Close
  Exit Sub
End If


Winsock1.SendData ("DATA" & vbCrLf)

VerificaResposta

If Not Mid(Dados, 1, 3) = "354" Then
  MsgBox "Ocorreu o seguinte erro no servidor : " & vbCrLf + Dados
  Winsock1.Close
  Exit Sub
End If

Winsock1.SendData "Subject: " & Assunto & "" & vbCrLf & _
                      "FROM: <" & Remetente & ">" & vbCrLf & _
                      "TO: <" & Destino & ">" & vbCrLf & _
                      "Mailer: JcmSoft" & vbCrLf & _
                      "Mime-Version: 1.0" & vbCrLf & _
                      "Content-Type:text/html" & "charset=us-ascii" & vbCrLf & vbCrLf & _
                      "C:\Users\rafael.brito\Desktop\NFE\Rigesa\11046-nfe.xml"
Winsock1.SendData vbCrLf & "." & vbCrLf

VerificaResposta

If Not Mid(Dados, 1, 3) = "250" Then
  MsgBox "Ocorreu o seguinte erro no servidor : " & vbCrLf + Dados
  Winsock1.Close
  Exit Sub
End If

Winsock1.SendData "QUIT"
MsgBox "Mensagem enviada com sucesso ", vbInformation, "Envia E-mail"
Winsock1.Close

Sub VerificaResposta()
    xLIBERA = False
    Do While xLIBERA = False
        DoEvents
    Loop
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Winsock1.GetData Dados, vbString
xLIBERA = True
End Sub

Desde já agradeço!!!!

Abraços!

Editado Outubro 27, 2010 por Rafa Mendonça
Adicionar tag CODE

[kuroi]

aqui tem exemplos de como se transfere arquivos com winsock: http://www.macoratti.net/vb_p2p.htm

agora pra mandar email, de uma lida nesse tópico: http://scriptbrasil.com.br/forum/index.php?showtopic=151691

[Rafa Mendonça]

Kuroi,

Muito Obrigado, era exatamente o que eu estava procurando.

Funcionou perfeitamente!

Abraço!

Editado Outubro 27, 2010 por Rafa Mendonça