'--------------------------------------------------
Public Connectf As Boolean
Public Answerf As Boolean
'------------------------------------------
Private Sub Command1_Click()
Help1.Show
End Sub
'---------------------------------
Private Sub Form_Load()
smtptest.Show
Servername.SetFocus
Answerf = False
Info.Text = Info.Text + vbCrLf
End Sub
'--------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
'----------------------------------------------------
Private Sub Send_Click()
Answerf = False
On Error GoTo Sendfail
Winsock1.RemoteHost = Servername.Text
Winsock1.Connect
Waiting
Connectf = True
Info.Text = Info.Text + vbCrLf + "Send Local Domain:" + vbCrLf
Info.SetFocus
SendKeys "^{END}", True
Winsock1.SendData "HELO " + Frsvr.Text + vbCrLf
Waiting
Info.Text = Info.Text + "From:" + vbCrLf
Info.SetFocus
SendKeys "^{END}", True
Winsock1.SendData "MAIL FROM:" + Fromxx.Text + vbCrLf
Waiting
Info.Text = Info.Text + "To:" + vbCrLf
Info.SetFocus
SendKeys "^{END}", True
Winsock1.SendData "RCPT TO:" + Toyy.Text + vbCrLf
Waiting
Info.Text = Info.Text + "Context;" + vbCrLf
Info.SetFocus
SendKeys "^{END}", True
Winsock1.SendData "DATA" + vbCrLf
Waiting
Winsock1.SendData "Subject:" + Subj.Text + vbCrLf
Winsock1.SendData "Reply-To:" + Fromxx.Text + vbCrLf
Winsock1.SendData "To:" + Toyy.Text + vbCrLf
Winsock1.SendData "Organization: Caveman's Club" + vbCrLf
Winsock1.SendData "X-mailer: Smtp tester v1.0(Written By Caveman)" + vbCrLf
Winsock1.SendData "Mime-Version: 1.0" + vbCrLf
Winsock1.SendData "Content-Type: text/plain; charset=""us-ascii""" + vbCrLf
Winsock1.SendData "Content-Transfer-Encoding: 7bit" + vbCrLf
Winsock1.SendData vbCrLf + Body.Text + vbCrLf
Winsock1.SendData vbCrLf + "." + vbCrLf
Waiting
Info.Text = Info.Text + "Exit Connection" + vbCrLf
Info.SetFocus
SendKeys "^{END}", True
Winsock1.SendData "QUIT" + vbCrLf
Waiting
Info.Text = Info.Text + vbCrLf + "Complete"+ vbCrLf
Info.Text = Info.Text + vbCrLf
Info.SetFocus
SendKeys "^{END}", True
Winsock1.Close
Exit Sub
Sendfail:
Info.Text = Info.Text + vbCrLf + "Send Failed" + vbCrLf
Info.SetFocus
SendKeys "^{END}", True
Winsock1.Close
Send.SetFocus
Connectf = False
Answerf = False
End Sub
'--------------------------------------------------------
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim Comedata As String
Winsock1.GetData Comedata
If Len(Info.Text) < 30000 Then
If Len(Info.Text + Comedata) < 60000 Then
Info.Text = Info.Text + Comedata
Else
Info.Text = Comedata
End If
Else
Info.Text = Comedata
End If
Info.SetFocus
SendKeys "^{END}", True
Answerf = True
End Sub
'--------------------------------------------------------
Public Sub Waiting()
Dim PauseTime, Start
PauseTime = 60
Start = Timer
Do While Timer < Start + PauseTime And Not Answerf
DoEvents
Loop
Answerf = False
End Sub