Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Sending a message
Message
 
À
29/11/1998 07:26:55
Information générale
Forum:
Visual Basic
Catégorie:
Fonctions API de Windows
Divers
Thread ID:
00161327
Message ID:
00162409
Vues:
17
Hi Guy (and everyone who is listening!!!)

While I was looking for the doc, I found a code sample of how to use Winsock to send mail. As you will, it is close to the code you paste me. I have tried this sample and it works very well.

You can be sure that I will remember this one!!! And I hope that everyone will copy it because it is very simple to bypass MAPI (for users which are always connected to the Net).

Here it is:

Option Explicit

'Description:Allows sending of e-mail (SMTP) directly from
'VB app using Winsock, WITH OUT having to buy an expensive
'on component

'//Input Requirements: Server Address (Name or IP), Senders & //Recipeient's Names, Sender & Recipient E-Mail address, Body of //message

Private mstrResponse As String

Private Sub SendEmail(ByVal pstrMailServerName As String, _
ByVal pstrFromEmailAddress As String, _
ByVal pstrToEmailAddress As String, _
ByVal pstrEmailSubject As String, _
ByVal pstrEmailBodyOfMessage As String)
Dim strDateNow As String
Dim strFirst As String
Dim strSecond As String
Dim strThird As String
Dim strFourth As String
Dim strFifth As String
Dim strSixth As String
Dim strSeventh As String
Dim strEighth As String
Dim strNinth As String

Winsock1.LocalPort = 0 ' Must set local port to 0 (Zero) or you can only send 1 e-mail per program start

strDateNow = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") & "" & " -0600"
strFirst = "mail from:" + Chr(32) + pstrFromEmailAddress + vbCrLf ' Get who's sending E-Mail address
strSecond = "rcpt to:" + Chr(32) + pstrToEmailAddress + vbCrLf ' Get who mail is going to
strThird = "Date:" + Chr(32) + strDateNow + vbCrLf ' Date when being sent
strFourth = "From:" + Chr(32) + pstrFromEmailAddress + vbCrLf ' Who's Sending
strFifth = "To:" + Chr(32) + pstrToEmailAddress + vbCrLf ' Who it going to
strSixth = "Subject:" + Chr(32) + pstrEmailSubject + vbCrLf ' Subject of E-Mail
strSeventh = pstrEmailBodyOfMessage + vbCrLf ' E-mail message body
strNinth = "X-Mailer: EBT Reporter v 2.x" + vbCrLf ' What program sent the e-mail, customize this
strEighth = strFourth + strThird + strNinth + strFifth + strSixth ' Combine for proper SMTP sending

With Winsock1
If .State = sckClosed Then ' Check to see if socet is closed
.Protocol = sckTCPProtocol ' Set protocol for sending
.RemoteHost = pstrMailServerName ' Set the server address
.RemotePort = 25 ' Set the SMTP Port
.Connect ' Start connection
WaitFor ("220")
lblStatus.Caption = "Connecting...."
lblStatus.Refresh
.SendData ("HELO worldcomputers.com" + vbCrLf)
WaitFor ("250")
lblStatus.Caption = "Connected"
lblStatus.Refresh
.SendData (strFirst)
lblStatus.Caption = "Sending Message"
lblStatus.Refresh
WaitFor ("250")
.SendData (strSecond)
WaitFor ("250")
.SendData ("data" + vbCrLf)
WaitFor ("354")
.SendData (strEighth + vbCrLf)
.SendData (strSeventh + vbCrLf)
.SendData ("." + vbCrLf)
WaitFor ("250")
.SendData ("quit" + vbCrLf)
lblStatus.Caption = "Disconnecting"
lblStatus.Refresh
WaitFor ("221")
.Close
Else
MsgBox (Str(.State))
End If
End With
End Sub

Sub WaitFor(strResponseCode As String)
Dim sngStart As Single
Dim sngTmr As Single

sngStart = Timer ' Time event so won't get stuck in loop

While Len(mstrResponse) = 0
sngTmr = sngStart - Timer
DoEvents ' Let System keep checking for incoming response **IMPORTANT**
If sngTmr > 50 Then ' Time in seconds to wait
MsgBox "SMTP service error, timed out while waiting for response", 64
Exit Sub
End If
Wend

While Left$(mstrResponse, 3) <> strResponseCode
DoEvents
If sngTmr > 50 Then
MsgBox "SMTP service error, impromper response code. Code should have been: " + strResponseCode + " Code recieved: " + mstrResponse, 64
Exit Sub
End If
Wend

mstrResponse = "" ' Sent response code to blank **IMPORTANT**
End Sub

Private Sub Command1_Click()
lblStatus.Caption = ""
lblStatus.Refresh
SendEmail txtEmailServer.Text, txtFromEmailAddress.Text, txtToEmailAddress.Text, txtEmailSubject.Text, txtEmailBodyOfMessage.Text
lblStatus.Caption = "Mail Sent"
lblStatus.Refresh
End Sub

Private Sub Command2_Click()
End
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Winsock1.GetData mstrResponse ' Check for incoming response *IMPORTANT*
End Sub
Éric Moreau, MCPD, Visual Developer - Visual Basic MVP
Conseiller Principal / Senior Consultant
Moer inc.
http://www.emoreau.com
Précédent
Répondre
Fil
Voir

Click here to load this message in the networking platform