Jump to content


Rafa Mendonça

Member Since 27/10/2010
Offline Last Active 17/11/2010, 07:16
-----

#1004940 Winsock Vb6

Posted by Rafa Mendonça on 27/10/2010, 09:53

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 alguem 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 ("Attachment: " & "C:\Users\rafael.brito\Desktop\NFE\Rigesa\11046-nfe.xml" & 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 Ja Agradeço!!

Abraços!!


IPB Skin By Virteq