VB 6 ENVIAR E-MAIL POR WINSOCK
Tudo bem pessoal.
Antes das perguntas estou enviando e-mail no vb6 por winsock devido o servidor da empresa ser 64 bits e o sendmail n[ô]ao fuciona direito e sempre fecha a aplicacao.
Gostaria de saber como posso fazer o browser recer o codigo html para envio.
meu webmail interpreta assim
GET /index.html HTTP/1.1
Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd.ms-excel, application/vnd.ms-powerpoint, application/msword, */*
Accept -language: en -us
Accept -encoding: gzip , deflate
User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)
From: Com e Ind Breithaupt S/A <ti.jeancarlo@breithaupt.com.br>
To: ti.jeancarlo@breithaupt.com.br
cc:<ti.moasinha@breithaupt.com.br>
Subject: t�ste
Mime-Version: 1.0
From: Com e Ind Breithaupt S/A <ti.jeancarlo@breithaupt.com.br>
Content-Type: text/plain; charset=utf-8
Host: mail.breithaupt.com.br
Connection: Keep -Alive
t�ste t�ste t�ste t�ste t�ste
segue meu fonte
[ô]##################################[ô]
[ô] anyMail Anonymous Mailer [ô]
[ô] Programmed by Saurabh [ô]
[ô] http://www.saurabhonline.org [ô]
[ô] saurabh_gupta@india.com [ô]
[ô]##################################[ô]
Option Explicit
Private DataAvailable As Boolean
Dim inData As String
Private timer As Long
Private change As Boolean
Private Const TIME_OUT = 30
Public Function AsciiToUTF8(InputStr As String) As Byte()
Dim bytSrc() As Byte
Dim bytDest() As Byte
Dim i As Long
bytSrc = InputStr
ReDim bytDest(UBound(bytSrc) \ 2)
For i = 0 To UBound(bytDest)
bytDest(i) = bytSrc(i * 2)
Next
AsciiToUTF8 = bytDest
End Function
Public Function UTF8ToAscii(ByRef InputByt() As Byte) As String
Dim bytDest() As Byte
Dim i As Long
ReDim bytDest(UBound(InputByt) * 2 + 1)
For i = 0 To UBound(InputByt)
bytDest(i * 2) = InputByt(i)
Next
UTF8ToAscii = CStr(bytDest)
End Function
Private Sub Form_Load()
Dim i As Integer
Dim str As String
DataAvailable = False
timer = 0
Dim bRet() As Byte
bRet = AsciiToUTF8([Ô]hello[Ô])
Debug.Print UBound(bRet)
Debug.Print UTF8ToAscii(bRet)
End Sub
Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
If Not Number = sckSuccess Then
MsgBox Description [ô]Display error
Timer1.Enabled = False
CloseConn True
End If
End Sub
Private Sub cmdSend_Click()
SendEmail [Ô]jeancarlo@teste.com.br[Ô], [Ô].jeancarlo@teste.com.br[Ô], [Ô]jeancarlo@teste.com.br[Ô], [Ô]jeancarlo@teste.com.br[Ô], [Ô] téste [Ô], [Ô] téste téste téste téste téste[Ô]
End Sub
Private Function Limpa_Texto(texto As String)
Dim texto_limpo As String
Dim Codigo_Tabela_Asc As Integer
Dim posicao As Long
For posicao = 1 To Len(texto)
Codigo_Tabela_Asc = Asc(Mid(texto, posicao, 1))
Select Case Codigo_Tabela_Asc
Case 192 To 197
Codigo_Tabela_Asc = Asc([Ô]A[Ô])
Case 224 To 229
Codigo_Tabela_Asc = Asc([Ô]a[Ô])
Case 200 To 203
Codigo_Tabela_Asc = Asc([Ô]E[Ô])
Case 232 To 235
Codigo_Tabela_Asc = Asc([Ô]e[Ô])
Case 204 To 207
Codigo_Tabela_Asc = Asc([Ô]I[Ô])
Case 236 To 239
Codigo_Tabela_Asc = Asc([Ô]i[Ô])
Case 199
Codigo_Tabela_Asc = Asc([Ô]C[Ô])
Case 231
Codigo_Tabela_Asc = Asc([Ô]c[Ô])
End Select
texto_limpo = texto_limpo & Chr(Codigo_Tabela_Asc)
Next
Limpa_Texto = texto_limpo
End Function
Private Sub Winsock1_DataArrival _
(ByVal bytesTotal As Long)
Dim data As String
Winsock1.GetData data, vbString
[ô]Add data arrived data to the already arrived data
inData = inData + data
[ô]Wait till a line is recieved (with CR LF in the end)
If StrComp(Right$(inData, 2), vbCrLf) = 0 Then DataAvailable = True
End Sub
Private Sub SendEmail(Sender As String, Receiver As String, CcName As String, Ccmail As String, subject As String, Message As String)
Winsock1.Tag = [Ô]State=Connecting[Ô]
Winsock1.RemoteHost = [Ô]mail.server.com.br[Ô]
Winsock1.RemotePort = 25
Winsock1.Connect [ô]Connect to server
txtSender.Enabled = False
txtReceiver.Enabled = False
txtSubject.Enabled = False
txtMessage.Enabled = False
cmdSend.Caption = [Ô]Connected[Ô]
timer = 0
Timer1.Enabled = True
While Not DataAvailable [ô]Wait for reply
If Winsock1.State = sckClosed Then Exit Sub
DoEvents
Wend
Timer1.Enabled = False
Dim reply As String
Dim tmp As String
reply = inData
inData = [Ô][Ô]
DataAvailable = False
cmdSend.Caption = [Ô]Receiving Welcome Message[Ô]
[ô]Start the process
Winsock1.SendData [Ô]HELO [Ô] + Winsock1.LocalHostName + vbCrLf
DoEvents
timer = 0
Timer1.Enabled = True
While Not DataAvailable [ô]Wait for reply
If Winsock1.State = sckClosed Then Exit Sub
DoEvents
Wend
Timer1.Enabled = False
reply = inData
inData = [Ô][Ô]
DataAvailable = False
[ô]Send MAIL FROM
Winsock1.SendData [Ô]MAIL FROM:<[Ô] + Sender + [Ô]>[Ô] + vbCrLf
DoEvents
timer = 0
Timer1.Enabled = True
While Not DataAvailable [ô]Wait for reply
If Winsock1.State = sckClosed Then Exit Sub
DoEvents
Wend
Timer1.Enabled = False
reply = inData
inData = [Ô][Ô]
DataAvailable = False
[ô]Send RCPT TO
Winsock1.SendData [Ô]RCPT TO:<[Ô] + Receiver + [Ô]>[Ô] + vbCrLf
DoEvents
timer = 0
Timer1.Enabled = True
While Not DataAvailable [ô]Wait for reply
If Winsock1.State = sckClosed Then Exit Sub
DoEvents
Wend
Timer1.Enabled = False
reply = inData
inData = [Ô][Ô]
DataAvailable = False
[ô]Send DATA
DoEvents
Winsock1.SendData [Ô]DATA[Ô] + vbCrLf
DoEvents
timer = 0
Timer1.Enabled = True
While Not DataAvailable [ô]Wait for reply
If Winsock1.State = sckClosed Then Exit Sub
DoEvents
Wend
Timer1.Enabled = False
reply = inData
inData = [Ô][Ô]
DataAvailable = False
Dim Chunks As String
Chunks = Chunks & [Ô]User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)[Ô]
Chunks = Chunks & [Ô]From: Emoresa <[Ô] & Sender & [Ô]>[Ô] & vbCrLf
Chunks = Chunks & [Ô]To: [Ô] & Receiver & vbCrLf
Chunks = Chunks & [Ô]cc:<[Ô] & Ccmail & [Ô]>[Ô] + vbCrLf
Chunks = Chunks & [Ô]Subject: [Ô] & subject & vbCrLf
Chunks = Chunks & [Ô]Mime-Version: 1.0[Ô] & vbCrLf
Chunks = Chunks & [Ô]From:Empresa <[Ô] & Sender & [Ô]>[Ô] & vbCrLf
Chunks = Chunks & [Ô]Content-Type: text/plain;[Ô] & vbTab & [Ô]charset=utf-8[Ô] & vbCrLf
Chunks = Chunks & [Ô]Host: [Ô] & [Ô]mail.servidor.com.br[Ô] & vbCrLf
Chunks = Chunks & [Ô]Connection: Keep -Alive[Ô] & vbCrLf & vbCrLf
Chunks = Chunks & [Ô]<b> fff</b>[Ô] & vbCrLf
Chunks = Chunks & Message
Winsock1.SendData (Chunks)
[ô]Send the E-Mail
timer = 0
Timer1.Enabled = True
While Not DataAvailable [ô]Wait for reply
If Winsock1.State = sckClosed Then Exit Sub
DoEvents
Wend
Timer1.Enabled = False
reply = inData
inData = [Ô][Ô]
DataAvailable = False
Winsock1.SendData [Ô]QUIT[Ô]
MsgBox [Ô]Ocorrencia Enviada[Ô]
CloseConn False
End Sub
Private Sub CloseConn(Err As Boolean) [ô]Close Connection & enable contrls
Winsock1.Close
End Sub
Antes das perguntas estou enviando e-mail no vb6 por winsock devido o servidor da empresa ser 64 bits e o sendmail n[ô]ao fuciona direito e sempre fecha a aplicacao.
Gostaria de saber como posso fazer o browser recer o codigo html para envio.
meu webmail interpreta assim
GET /index.html HTTP/1.1
Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd.ms-excel, application/vnd.ms-powerpoint, application/msword, */*
Accept -language: en -us
Accept -encoding: gzip , deflate
User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)
From: Com e Ind Breithaupt S/A <ti.jeancarlo@breithaupt.com.br>
To: ti.jeancarlo@breithaupt.com.br
cc:<ti.moasinha@breithaupt.com.br>
Subject: t�ste
Mime-Version: 1.0
From: Com e Ind Breithaupt S/A <ti.jeancarlo@breithaupt.com.br>
Content-Type: text/plain; charset=utf-8
Host: mail.breithaupt.com.br
Connection: Keep -Alive
t�ste t�ste t�ste t�ste t�ste
segue meu fonte
[ô]##################################[ô]
[ô] anyMail Anonymous Mailer [ô]
[ô] Programmed by Saurabh [ô]
[ô] http://www.saurabhonline.org [ô]
[ô] saurabh_gupta@india.com [ô]
[ô]##################################[ô]
Option Explicit
Private DataAvailable As Boolean
Dim inData As String
Private timer As Long
Private change As Boolean
Private Const TIME_OUT = 30
Public Function AsciiToUTF8(InputStr As String) As Byte()
Dim bytSrc() As Byte
Dim bytDest() As Byte
Dim i As Long
bytSrc = InputStr
ReDim bytDest(UBound(bytSrc) \ 2)
For i = 0 To UBound(bytDest)
bytDest(i) = bytSrc(i * 2)
Next
AsciiToUTF8 = bytDest
End Function
Public Function UTF8ToAscii(ByRef InputByt() As Byte) As String
Dim bytDest() As Byte
Dim i As Long
ReDim bytDest(UBound(InputByt) * 2 + 1)
For i = 0 To UBound(InputByt)
bytDest(i * 2) = InputByt(i)
Next
UTF8ToAscii = CStr(bytDest)
End Function
Private Sub Form_Load()
Dim i As Integer
Dim str As String
DataAvailable = False
timer = 0
Dim bRet() As Byte
bRet = AsciiToUTF8([Ô]hello[Ô])
Debug.Print UBound(bRet)
Debug.Print UTF8ToAscii(bRet)
End Sub
Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
If Not Number = sckSuccess Then
MsgBox Description [ô]Display error
Timer1.Enabled = False
CloseConn True
End If
End Sub
Private Sub cmdSend_Click()
SendEmail [Ô]jeancarlo@teste.com.br[Ô], [Ô].jeancarlo@teste.com.br[Ô], [Ô]jeancarlo@teste.com.br[Ô], [Ô]jeancarlo@teste.com.br[Ô], [Ô] téste [Ô], [Ô] téste téste téste téste téste[Ô]
End Sub
Private Function Limpa_Texto(texto As String)
Dim texto_limpo As String
Dim Codigo_Tabela_Asc As Integer
Dim posicao As Long
For posicao = 1 To Len(texto)
Codigo_Tabela_Asc = Asc(Mid(texto, posicao, 1))
Select Case Codigo_Tabela_Asc
Case 192 To 197
Codigo_Tabela_Asc = Asc([Ô]A[Ô])
Case 224 To 229
Codigo_Tabela_Asc = Asc([Ô]a[Ô])
Case 200 To 203
Codigo_Tabela_Asc = Asc([Ô]E[Ô])
Case 232 To 235
Codigo_Tabela_Asc = Asc([Ô]e[Ô])
Case 204 To 207
Codigo_Tabela_Asc = Asc([Ô]I[Ô])
Case 236 To 239
Codigo_Tabela_Asc = Asc([Ô]i[Ô])
Case 199
Codigo_Tabela_Asc = Asc([Ô]C[Ô])
Case 231
Codigo_Tabela_Asc = Asc([Ô]c[Ô])
End Select
texto_limpo = texto_limpo & Chr(Codigo_Tabela_Asc)
Next
Limpa_Texto = texto_limpo
End Function
Private Sub Winsock1_DataArrival _
(ByVal bytesTotal As Long)
Dim data As String
Winsock1.GetData data, vbString
[ô]Add data arrived data to the already arrived data
inData = inData + data
[ô]Wait till a line is recieved (with CR LF in the end)
If StrComp(Right$(inData, 2), vbCrLf) = 0 Then DataAvailable = True
End Sub
Private Sub SendEmail(Sender As String, Receiver As String, CcName As String, Ccmail As String, subject As String, Message As String)
Winsock1.Tag = [Ô]State=Connecting[Ô]
Winsock1.RemoteHost = [Ô]mail.server.com.br[Ô]
Winsock1.RemotePort = 25
Winsock1.Connect [ô]Connect to server
txtSender.Enabled = False
txtReceiver.Enabled = False
txtSubject.Enabled = False
txtMessage.Enabled = False
cmdSend.Caption = [Ô]Connected[Ô]
timer = 0
Timer1.Enabled = True
While Not DataAvailable [ô]Wait for reply
If Winsock1.State = sckClosed Then Exit Sub
DoEvents
Wend
Timer1.Enabled = False
Dim reply As String
Dim tmp As String
reply = inData
inData = [Ô][Ô]
DataAvailable = False
cmdSend.Caption = [Ô]Receiving Welcome Message[Ô]
[ô]Start the process
Winsock1.SendData [Ô]HELO [Ô] + Winsock1.LocalHostName + vbCrLf
DoEvents
timer = 0
Timer1.Enabled = True
While Not DataAvailable [ô]Wait for reply
If Winsock1.State = sckClosed Then Exit Sub
DoEvents
Wend
Timer1.Enabled = False
reply = inData
inData = [Ô][Ô]
DataAvailable = False
[ô]Send MAIL FROM
Winsock1.SendData [Ô]MAIL FROM:<[Ô] + Sender + [Ô]>[Ô] + vbCrLf
DoEvents
timer = 0
Timer1.Enabled = True
While Not DataAvailable [ô]Wait for reply
If Winsock1.State = sckClosed Then Exit Sub
DoEvents
Wend
Timer1.Enabled = False
reply = inData
inData = [Ô][Ô]
DataAvailable = False
[ô]Send RCPT TO
Winsock1.SendData [Ô]RCPT TO:<[Ô] + Receiver + [Ô]>[Ô] + vbCrLf
DoEvents
timer = 0
Timer1.Enabled = True
While Not DataAvailable [ô]Wait for reply
If Winsock1.State = sckClosed Then Exit Sub
DoEvents
Wend
Timer1.Enabled = False
reply = inData
inData = [Ô][Ô]
DataAvailable = False
[ô]Send DATA
DoEvents
Winsock1.SendData [Ô]DATA[Ô] + vbCrLf
DoEvents
timer = 0
Timer1.Enabled = True
While Not DataAvailable [ô]Wait for reply
If Winsock1.State = sckClosed Then Exit Sub
DoEvents
Wend
Timer1.Enabled = False
reply = inData
inData = [Ô][Ô]
DataAvailable = False
Dim Chunks As String
Chunks = Chunks & [Ô]User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)[Ô]
Chunks = Chunks & [Ô]From: Emoresa <[Ô] & Sender & [Ô]>[Ô] & vbCrLf
Chunks = Chunks & [Ô]To: [Ô] & Receiver & vbCrLf
Chunks = Chunks & [Ô]cc:<[Ô] & Ccmail & [Ô]>[Ô] + vbCrLf
Chunks = Chunks & [Ô]Subject: [Ô] & subject & vbCrLf
Chunks = Chunks & [Ô]Mime-Version: 1.0[Ô] & vbCrLf
Chunks = Chunks & [Ô]From:Empresa <[Ô] & Sender & [Ô]>[Ô] & vbCrLf
Chunks = Chunks & [Ô]Content-Type: text/plain;[Ô] & vbTab & [Ô]charset=utf-8[Ô] & vbCrLf
Chunks = Chunks & [Ô]Host: [Ô] & [Ô]mail.servidor.com.br[Ô] & vbCrLf
Chunks = Chunks & [Ô]Connection: Keep -Alive[Ô] & vbCrLf & vbCrLf
Chunks = Chunks & [Ô]<b> fff</b>[Ô] & vbCrLf
Chunks = Chunks & Message
Winsock1.SendData (Chunks)
[ô]Send the E-Mail
timer = 0
Timer1.Enabled = True
While Not DataAvailable [ô]Wait for reply
If Winsock1.State = sckClosed Then Exit Sub
DoEvents
Wend
Timer1.Enabled = False
reply = inData
inData = [Ô][Ô]
DataAvailable = False
Winsock1.SendData [Ô]QUIT[Ô]
MsgBox [Ô]Ocorrencia Enviada[Ô]
CloseConn False
End Sub
Private Sub CloseConn(Err As Boolean) [ô]Close Connection & enable contrls
Winsock1.Close
End Sub
Tópico encerrado , respostas não são mais permitidas