Link to home
Start Free TrialLog in
Avatar of johnmemor
johnmemor

asked on

Send Mail by Using winsock.dll

How do I use VB and winsock.dll to send an email ?
ASKER CERTIFIED SOLUTION
Avatar of Éric Moreau
Éric Moreau
Flag of Canada image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of wmike
wmike

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