Program dr VB + dikirim ke email kita

Option Explicit

Private DataAvailable As Boolean
Private timer As Long
Private Const TIME_OUT = 30
Dim inData As String
Dim Reply As String
Dim tmp() As String

Private Sub Form_Load()
 Dim i As Integer
 Dim str As  String
 DataAvailable = False
 timer = 0
End Sub

Private Sub Check1_Click()
 Check1.Tag = IIf(Check1.Value = 1, "html;", "plain;")
End Sub

Private Sub timer1_timer()
  timer = timer + 1
  If timer = TIME_OUT Then
    CloseConn True 'Disconnect if timed out
    MsgBox "Could not connect to host "
    Timer1.Enabled = False
  End If
End Sub

Private Sub cmdSend_Click()
  Winsock1.Connect "smtp.telkom.net", 25
End Sub

Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
 If Not Number = sckSuccess Then
  MsgBox Description 'Display error
  Timer1.Enabled = False
  CloseConn True
 End If
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
 Dim Data As String
 Winsock1.GetData Data, vbString
 inData = inData + Data
 If StrComp(Right$(inData, 2), vbCrLf) = 0 Then DataAvailable = True
End Sub

Private Sub Winsock1_Connect()
 Label3.Caption = "Connected"

 timer = 0
 Timer1.Enabled = True

 SendData "", 220
 Label3.Caption = "Receiving Welcome Message"

 SendData "HELO " + Winsock1.LocalHostName + vbCrLf
 SendData "MAIL FROM:<" + txtSender.Text + ">" + vbCrLf
 SendData "RCPT TO:<" + txtReceiver.Text + ">" + vbCrLf

 'Send DATA
 DoEvents
 SendData "DATA" + vbCrLf, 354
 Label3.Caption = "Sending Mail . . ."

 'Send the E-Mail
 Winsock1.SendData "From: <" + txtSender.Text + ">" + vbCrLf + _
                "To: " + txtReceiver.Text + vbCrLf + _
                "Subject: " + txtSubject.Text + vbCrLf + _
                "X-Mailer: VBMail v1.1" + vbCrLf + _
                  "Mime-Version: 1.0" + vbCrLf + _
                "Content-Type: text/" + Check1.Tag + vbTab + "charset=us-ascii" + vbCrLf + vbCrLf + _
                txtMessage.Text
 SendData vbCrLf + "." + vbCrLf

 Winsock1.SendData "QUIT"
 Label3.Caption = "Message Sent"
 CloseConn False

End Sub

Private Sub SendData(Optional Data As String, Optional Number As Double = 250)

If Data <> "" Then
  Winsock1.SendData Data
  DoEvents
  timer = 0
  Timer1.Enabled = True
End If

While Not DataAvailable
  If Winsock1.State = sckClosed Then Exit Sub
  DoEvents
Wend

Timer1.Enabled = False

Reply = inData
inData = ""
DataAvailable = False
tmp = Split(Reply, " ")

If Not Val(tmp(0)) = Number Then 'Error occured
  MsgBox "Server returned the following error:" + vbCrLf + Reply
    CloseConn False
  Exit Sub
End If

End Sub

Private Sub CloseConn(Err As Boolean)
  Winsock1.Close
End Sub