• Home
 · 
• Internet/HTML
 · 
• SMTP Mail this code send smtp mail using winsock

SMTP Mail this code send smtp mail using winsock

SMTP Mail this code send smtp mail using winsock

Rate SMTP Mail this code send smtp mail using winsock

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

Dim Start As Single, Tmr As Single


Sub SendEmail(MailServerName As String, FromName As String, FromEmailAddress As String, ToName As String, ToEmailAddress As String, EmailSubject As String, EmailBodyOfMessage As String)
Dim DateNow As String
Dim first As String, Second As String, Third As String
Dim Fourth As String, Fifth As String, Sixth As String
Dim Seventh As String
With Winsock1
    If .State = sckClosed Then ' Check to see if socket is closed
        DateNow = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") & "" & " -0600"
        first = "mail from: " & FromEmailAddress & vbCrLf ' Get who's sending E-Mail address
        Second = "rcpt to: " & ToEmailAddress & vbCrLf ' Get who mail is going to
        Third = "Date: " & DateNow & vbCrLf ' Date when being sent
        Fourth = "From: """ & FromName & """ <" & FromEmailAddress & ">" + vbCrLf ' Who's Sending
        Fifth = "To: " & ToNametxt & vbCrLf ' Who it going to
        Sixth = "Subject: " & EmailSubject & vbCrLf ' Subject of E-Mail
        Seventh = EmailBodyOfMessage & vbCrLf ' E-mail message body
        Ninth = "X-Mailer: STMP Sender" & vbCrLf ' What program sent the e-mail, customize this
        .LocalPort = 0 ' Must set local port to 0 (Zero) or you can only send 1 e-mail per program start
        .Protocol = sckTCPProtocol ' Set protocol for sending
        .RemoteHost = MailServerName ' Set the server address
        .RemotePort = 25 ' Set the SMTP Port
        .Connect ' Start connection
        WaitFor ("220")
        StatusTxt.Caption = "Connecting...."
        .SendData ("HELO EnterComputerNameHere" & vbCrLf)
        WaitFor ("250")
        StatusTxt.Caption = "Connected"

        .SendData (first)
        StatusTxt.Caption = "Sending Message"

        WaitFor ("250")
        .SendData (Second)
        WaitFor ("250")
        .SendData ("data" & vbCrLf)
        WaitFor ("354")
        .SendData (Fourth & Third & Ninth & Fifth & Sixth & vbCrLf)
        .SendData (Seventh & vbCrLf)
        .SendData ("." & vbCrLf)
        WaitFor ("250")
        .SendData ("quit" & vbCrLf)
        StatusTxt.Caption = "Disconnecting"

        WaitFor ("221")
        .Close
    Else
        MsgBox (Str(.State))
    End If
End With
End Sub


Sub WaitFor(ResponseCode As String)
    Start = Timer ' Time event so won't get stuck in loop
    While Len(Response) = 0
        Tmr = Start - Timer
        DoEvents ' Let System keep checking for incoming response **IMPORTANT**
        If Tmr > 50 Then ' Time in seconds to wait
            MsgBox "SMTP service error, timed out while waiting for response", 64, MsgTitle
            Exit Sub
        End If
    Wend
    While Left(Response, 3) <> ResponseCode
        DoEvents
        If Tmr > 50 Then
           MsgBox "SMTP service error, impromper response code. Code should have been: " + ResponseCode + " Code recieved: " + Response, 64, MsgTitle
           Exit Sub
        End If
    Wend
    Response = "" ' Sent response code to blank **IMPORTANT**
End Sub


Private Sub CmdSendMail_Click()
    SendEmail txtEmailServer.Text, txtFromName.Text, txtFromEmailAddress.Text, txtToEmailAddress.Text, txtToEmailAddress.Text, txtEmailSubject.Text, txtMessage.Text
    StatusTxt.Caption = "Mail Sent"
    Beep
    Close
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Winsock1.GetData Response ' Check for incoming response *IMPORTANT*
End Sub