Improve company productivity with a Business Account.Sign Up

x
?
Solved

Send Mail by Using winsock.dll

Posted on 2001-07-17
3
Medium Priority
?
306 Views
Last Modified: 2013-11-13
How do I use VB and winsock.dll to send an email ?
0
Comment
Question by:johnmemor
3 Comments
 
LVL 71

Accepted Solution

by:
Éric Moreau earned 120 total points
ID: 6291372
0
 

Expert Comment

by:wmike
ID: 6292168
add a form to your project and put a Winsock control on it.
Just load the form, you don't have to show it.
Then use the SendEmail routine.


----------------------------
Public AppName As String
Public ResponseString As String

Public Sub SendEmail(MailServerName As String, SenderName As String, SenderEmailAddress As String, RecipientName As String, RecipientEmailAddress As String, EmailSubject As String, EmailBodyOfMessage As String)
   
    MailServerName = Trim(MailServerName)
    SenderName = Trim(SenderName)
    SenderEmailAddress = Trim(SenderEmailAddress)
    RecipientName = Trim(RecipientName)
    RecipientEmailAddress = Trim(RecipientEmailAddress)
    EmailSubject = Trim(EmailSubject)
    EmailBodyOfMessage = Trim(EmailBodyOfMessage)
   
    Dim Data1 As String, Data2 As String
    Dim Data3 As String, Data4 As String
    Dim Data5 As String, Data6 As String
    Dim Data7 As String, Data8 As String
    Dim CurrentDate As String
    Dim TimeDifference As String
   
    'Set the Winsock control's local port to 0, because otherwise
    'you may not be able to send more than one e-mail message
    'every time the program runs
    'form_frmemail.Winsock1.LocalPort = 0
   
    'Start composing the required data strings, but first check
    'if the Winsock socket is closed
    If Winsock1.State = sckClosed Then
        'Compose the current date and time string
        TimeDifference = " -200"
        CurrentDate = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") & TimeDifference
        'Set the program name used to send this e-mail message (you can
        'put your program name here)
        AppName = "X-Mailer: " + "My Mail Program V1.0" + Chr(13) + Chr(10)
        'Set the e-mail address of the sender
        Data1 = "mail from:" + Chr(32) + SenderEmailAddress + Chr(13) + Chr(10)
        'Set the e-mail address of the recipient
        Data2 = "rcpt to:" + Chr(32) + RecipientEmailAddress + Chr(13) + Chr(10)
        'Set the date string
        Data3 = "Date:" + Chr(32) + CurrentDate + Chr(13) + Chr(10)
        'Set the name of the sender
        Data4 = "From:" + Chr(32) + SenderName + Chr(13) + Chr(10)
        'Set the name of the recipient
        Data5 = "To:" + Chr(32) + RecipientName + Chr(13) + Chr(10)
        'Set the subject of the E-Mail message
        Data6 = "Subject:" + Chr(32) + EmailSubject + Chr(13) + Chr(10)
        'Set the E-mail message body string
        Data7 = EmailBodyOfMessage + Chr(13) + Chr(10)
        'Combine the whole string for proper SMTP syntax
        Data8 = Data4 + Data3 + AppName + Data5 + Data6
   
        'Set the Winsock protocol
        Winsock1.Protocol = sckTCPProtocol
        'Set the remote host name (of SMTP server)
        Winsock1.RemoteHost = MailServerName
        'Set the SMTP Port to the default port 25
        Winsock1.RemotePort = 25
       
        'Start the connection
        Winsock1.Connect
        'Wait for ResponseString from the remote host
        WaitForResponseString ("220")
       
        'Report status
        'StatusLabel.Caption = "Connecting...."
        'StatusLabel.Refresh
       
        'Send your computer name or company name
        Winsock1.SendData ("HELO mycomputername" + Chr(13) + Chr(10))
        'Wait for ResponseString from the remote host
        WaitForResponseString ("250")
   
        'Update status
        'StatusLabel.Caption = "Connected"
        'StatusLabel.Refresh
   
        'Send the first string
        Winsock1.SendData (Data1)
   
        'Update status
        'StatusLabel.Caption = "Sending Message"
        'StatusLabel.Refresh
   
        'Wait for ResponseString from the remote host
        WaitForResponseString ("250")
   
        'Send the second string
        Winsock1.SendData (Data2)
   
        'Wait for ResponseString from the remote host
        WaitForResponseString ("250")
   
        'Tell the SMTP server that you want to send data now
        Winsock1.SendData ("data" + Chr(13) + Chr(10))
       
        'Wait for ResponseString from the remote host
        WaitForResponseString ("354")
   
        'Send the data
        Winsock1.SendData (Data8 + Chr(13) + Chr(10))
        Winsock1.SendData (Data7 + Chr(13) + Chr(10))
        Winsock1.SendData ("." + Chr(13) + Chr(10))
   
        'Wait for ResponseString from the remote host
        WaitForResponseString ("250")
   
        'Send quitting acknowledgment
        Winsock1.SendData ("quit" + Chr(13) + Chr(10))
       
        'Update status
        'StatusLabel.Caption = "Disconnecting"
        'StatusLabel.Refresh
   
        'Wait for ResponseString from the remote host
        WaitForResponseString ("221")
   
        'Close the connection
        Winsock1.Close
    Else
        'Report error
        MsgBox (Str(Winsock1.State))
    End If
   
End Sub

Public Sub WaitForResponseString(ResponseStringCode As String)
   
    Dim Startt As Single
    Dim TimeToWait As Single

    Startt = Timer
    'Start a loop checking for ResponseString from SMTP host
    While Len(ResponseString) = 0
        TimeToWait = Timer - Startt
        DoEvents
        'If TimeToWait expires, report timeout error
        If TimeToWait > 50 Then
            'MsgBox "SMTP timeout error, no ResponseString received", 64, App.Title
            MsgBox "SMTP timeout error, no ResponseString received", 64, AppName
            Exit Sub
        End If
    Wend
    While Left(ResponseString, 3) <> ResponseStringCode
        DoEvents
        If TimeToWait > 50 Then
            'Report error if incorrect code is received
            MsgBox "SMTP error, improper ResponseString code received!" + Chr(10) + "Correct code is: " + ResponseStringCode + ", Code received: " + ResponseString, 64, AppName
            Exit Sub
        End If
    Wend

    'Set ResponseString to nothing
    ResponseString = ""

End Sub

Public Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

    'Check for ResponseString from the remote host
    Winsock1.GetData ResponseString

End Sub
0
 
LVL 56

Expert Comment

by:Ryan Chong
ID: 6292179
0

Featured Post

What Kind of Coding Program is Right for You?

There are many ways to learn to code these days. From coding bootcamps like Flatiron School to online courses to totally free beginner resources. The best way to learn to code depends on many factors, but the most important one is you. See what course is best for you.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

When we want to run, execute or repeat a statement multiple times, a loop is necessary. This article covers the two types of loops in Python: the while loop and the for loop.
Article by: evilrix
Looking for a way to avoid searching through large data sets for data that doesn't exist? A Bloom Filter might be what you need. This data structure is a probabilistic filter that allows you to avoid unnecessary searches when you know the data defin…
The goal of the tutorial is to teach the user how to use functions in C++. The video will cover how to define functions, how to call functions and how to create functions prototypes. Microsoft Visual C++ 2010 Express will be used as a text editor an…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

608 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question