VERSION 5.00
Begin VB.Form frmMain 
   Caption         =   "Fake Email!"
   ClientHeight    =   4260
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5670
   LinkTopic       =   "Form1"
   ScaleHeight     =   4260
   ScaleWidth      =   5670
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox txtSubject 
      Height          =   375
      Left            =   720
      TabIndex        =   7
      Text            =   "Subject"
      Top             =   1440
      Width           =   2655
   End
   Begin VB.TextBox txtSendToName 
      Height          =   375
      Left            =   2160
      TabIndex        =   6
      Text            =   "Name"
      Top             =   360
      Width           =   1215
   End
   Begin VB.TextBox txtSendFromName 
      Height          =   375
      Left            =   2160
      TabIndex        =   5
      Text            =   "Name"
      Top             =   840
      Width           =   1215
   End
   Begin VB.TextBox txtSendFrom 
      Height          =   375
      Left            =   720
      TabIndex        =   4
      Text            =   "Send From"
      Top             =   840
      Width           =   1215
   End
   Begin VB.ListBox lstSrvMsgs 
      Height          =   1425
      Left            =   3840
      TabIndex        =   3
      Top             =   1440
      Width           =   1215
   End
   Begin VB.TextBox txtSendTo 
      Height          =   375
      Left            =   720
      TabIndex        =   2
      Text            =   "Send To"
      Top             =   360
      Width           =   1215
   End
   Begin VB.TextBox txtMessage 
      Height          =   1095
      Left            =   720
      TabIndex        =   1
      Text            =   "Message"
      Top             =   1920
      Width           =   2655
   End
   Begin VB.CommandButton cmdSend 
      Caption         =   "Send"
      Height          =   495
      Left            =   1320
      TabIndex        =   0
      Top             =   3240
      Width           =   1215
   End
   Begin VB.PictureBox Winsock1 
      Height          =   480
      Left            =   120
      ScaleHeight     =   420
      ScaleWidth      =   1140
      TabIndex        =   8
      Top             =   120
      Width           =   1200
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Response As String

Private Sub cmdSend_Click()
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) & "your.email.addr@work.com" & vbCrLf
        Data1 = "mail from:" & Chr(32) & txtSendFrom.Text & vbCrLf
        
        'Set the e-mail address of the recipient
        'Data2 = "rcpt to:" & Chr(32) & "my.mate@somewhere.co.uk" & vbCrLf
        Data2 = "rcpt to:" & Chr(32) & txtSendTo.Text & vbCrLf
        
        'Set the date string
        Data3 = "Date: " & Chr(32) & CurrentDate & vbCrLf
        
        'Set the name of the sender
        'Data4 = "From: " & Chr(32) & "Senders Name" & vbCrLf
        Data4 = "From: " & Chr(32) & txtSendFromName.Text & vbCrLf
        
        'Set the name of the recipient
        'Data5 = "To: " & Chr(32) & "Recipient Name" & vbCrLf
        Data5 = "To: " & Chr(32) & txtSendToName.Text & vbCrLf
        
        'Set the subject of the E-Mail message
        'Data6 = "Subject: " & Chr(32) & "Test Subject" & vbCrLf
        Data6 = "Subject: " & Chr(32) & txtSubject.Text & vbCrLf
        
        'Set the E-mail message body string
        'Data7 = "Body of message" & vbCrLf
        Data7 = txtMessage.Text & 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 = "callisto.unm.edu"

        
        '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 Lancashire" & 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 txtMessage_GotFocus()
' Start highlight before first character.
txtMessage.SelStart = 0
' Highlight to end of text.
txtMessage.SelLength = Len(txtMessage.Text)
End Sub

Private Sub txtSendFrom_GotFocus()
' Start highlight before first character.
txtSendFrom.SelStart = 0
' Highlight to end of text.
txtSendFrom.SelLength = Len(txtSendFrom.Text)
End Sub

Private Sub txtSendFromName_GotFocus()
' Start highlight before first character.
txtSendFromName.SelStart = 0
' Highlight to end of text.
txtSendFromName.SelLength = Len(txtSendFromName.Text)
End Sub

Private Sub txtSendTo_GotFocus()
' Start highlight before first character.
txtSendTo.SelStart = 0
' Highlight to end of text.
txtSendTo.SelLength = Len(txtSendTo.Text)
End Sub

Private Sub txtSendToName_GotFocus()
' Start highlight before first character.
txtSendToName.SelStart = 0
' Highlight to end of text.
txtSendToName.SelLength = Len(txtSendToName.Text)
End Sub

Private Sub txtSubject_GotFocus()
' Start highlight before first character.
txtSubject.SelStart = 0
' Highlight to end of text.
txtSubject.SelLength = Len(txtSubject.Text)
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

    'Check for response from the remote host
    Winsock1.GetData Response

End Sub