This is a copy of the email program using the winsock control
from the Easier to Read code of steve65
Can any please convert this in winsock API.
The part i'm having trouble is the sub "WaitForResponse(ResponseCode As String)"
Code:Option Explicit
Dim Response As String
Private Sub cmdOriginal_Click(Index As Integer)
Call SendMail
End Sub
Sub SendMail()
Dim AppName As String
Dim Data1 As String
Dim Data2 As String
Dim Data3 As String
Dim Data4 As String
Dim Data5 As String
Dim Data6 As String
Dim Data7 As String
Dim 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
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" 'Your zone time-difference
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" & vbCrLf
'Set the e-mail address of the sender
Data1 = "mail from:" & Chr(32) & "[email protected]" & vbCrLf
'Set the e-mail address of the recipient
Data2 = "rcpt to:" & Chr(32) & "[email protected]" & vbCrLf
'Set the date string
Data3 = "Date: " & Chr(32) & CurrentDate & vbCrLf
'Set the name of the sender
Data4 = "From: " & Chr(32) & "Senders Name" & vbCrLf
'Set the name of the recipient
Data5 = "To: " & Chr(32) & "Recipient Name" & vbCrLf
'Set the subject of the E-Mail message
Data6 = "Subject: " & Chr(32) & "Test Subject" & vbCrLf
'Set the E-mail message body string
Data7 = "Body of message" & vbCrLf
'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 = "mail.smtp.server.com"
'Set the SMTP Port to the default port 25
Winsock1.RemotePort = 25
'Start the connection
Winsock1.Connect
'Wait for response from the remote host
WaitForResponse ("220")
'Send your computer name or company name
Winsock1.SendData ("HELO Your Computer Name" & vbCrLf)
'Wait for response from the remote host
WaitForResponse ("250")
Winsock1.SendData (Data1)
WaitForResponse ("250")
Winsock1.SendData (Data2)
WaitForResponse ("250")
'Tell the SMTP server that you want to send data now
Winsock1.SendData ("data" & vbCrLf)
'Wait for response from the remote host
WaitForResponse ("354")
'Send the data
Winsock1.SendData (Data8 & vbCrLf)
Winsock1.SendData (Data7 & vbCrLf)
Winsock1.SendData ("." & vbCrLf)
'Wait for response from the remote host
WaitForResponse ("250")
'Send quitting acknowledgment
Winsock1.SendData ("quit" & vbCrLf)
'Wait for response from the remote host
WaitForResponse ("221")
'Close the connection
Winsock1.Close
Else
'Report Error
MsgBox (Str(Winsock1.State))
End If
End Sub
Sub WaitForResponse(ResponseCode As String)
Dim Start As Single
Dim TimeToWait As Single
Start = Timer
'Start a loop checking for response from SMTP host
While Len(Response) = 0
TimeToWait = Start - Timer
DoEvents
'If TimeToWait expires, report timeout error
If TimeToWait > 50 Then
MsgBox "SMTP timeout error, no response received", 64, App.Title
Exit Sub
End If
Wend
While Left(Response, 3) <> ResponseCode
DoEvents
If TimeToWait > 50 Then
'Report error if incorrect code is received
MsgBox "SMTP error, improper response code received!" & Chr(10) & _
"Correct code is: " & ResponseCode & ", Code received: " & _
Response, 64, App.Title
Exit Sub
End If
Wend
'Set response to nothing
Response = ""
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
'Check for response from the remote host
Winsock1.GetData Response
End Sub
