Solved

Send Mail by Using winsock.dll

Posted on 2001-07-17
3
260 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 70

Accepted Solution

by:
Éric Moreau earned 30 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 51

Expert Comment

by:Ryan Chong
ID: 6292179
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
mapAB Challlenge 35 160
passing parameter in sql procedure 9 65
SQL VB connection works in one PC and doesn't in another 15 68
Set WorkSheet  not Working 9 44
If you haven’t already, I encourage you to read the first article (http://www.experts-exchange.com/articles/18680/An-Introduction-to-R-Programming-and-R-Studio.html) in my series to gain a basic foundation of R and R Studio.  You will also find the …
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
The viewer will learn how to implement Singleton Design Pattern in Java.
The goal of the video will be to teach the user the concept of local variables and scope. An example of a locally defined variable will be given as well as an explanation of what scope is in C++. The local variable and concept of scope will be relat…

820 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