Making me Mad!

[usaf002]

I got code from PlanetSoruceCode.com and it is not working corretly it is to send e-mail through Winsock. The problem is, it connects and then when Status.Caption says "Sending Data 1/3" it dosent get past that part. It just stays there I have Winsock1, the Local Port = 6000
and the Remote Port = 25
*This is NOT my code*

Private Sub Command1_Click()
Dim sRes As String

    Winsock1.RemotePort = 25
    Winsock1.RemoteHost = frmOptions.txtSMPT_Host
    Winsock1.Connect

Status.Caption = ("Connecting to " & frmOptions.txtSMPT_Host & "Hold...")
    Do Until Winsock1.State = 7 '7=connected


        DoEvents
        Loop
        sRes = "0"
        Winsock1.SendData "MAIL FROM: " & txtMail_From

Status.Caption = "Sending Data 1/3"
        Do Until sRes = "250"


            DoEvents
            Loop
            sRes = "0"
            Winsock1.SendData "RCPT TO: " & txtrcpt_to

Status.Caption = "Sending Data 2/3"
            Do Until sRes = "250"


                DoEvents
                Loop
                sRes = "0"
                Winsock1.SendData "DATA" & vbCrLf

Status.Caption = "Sending Data 3/3"
                Do Until sRes = "354"


                    DoEvents
                    Loop
                    Winsock1.SendData "FROM: " & txtFrom
                    Winsock1.SendData "SUBJECT: " & txtSubject
                    Winsock1.SendData Text1.Text & vbCrLf & "." & vbCrLf
Status.Caption = "Sending Data -> Mass"

                    Do Until sRes = "250"


                        DoEvents
                        Loop
                        Winsock1.Close
Status.Caption = ("Mail sent to" & txtMail_To.Text & "@ " & txtrcpt_to.Text & "Successful")
                    End Sub



Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim DATA As String
    Dim Length As Long
    Winsock1.GetData DATA
    Length = Len(DATA)
    sRes = Left$(DATA, 3)
End Sub

Could someone look that over and please tell me what the heck is going wrong.

Thanks!!

[Thread1]

Maybe it's all about the declaration of the sRes variable (scope)..which is used as the synchronization flag between you and the server.

Try to declare this at the top (module level) not in the Command1_Click sub.

[morrowasted]

i dont know anything about it sry!

[Thread1]

morrowasted, the sRes variable seemed to hold the reply from the email server for every senddata method of the program. As you can see for every senddata method from the Command1_Click routine there's the loop for sRes variable waiting for something that the variable's content should change

Waiting for reply from the server

Do until sRes = <Something>
Doevents
Loop

And the email server reply should change this sRes value as showed in Winsock1_DataArrival routine.

And finally, this should be the right code :

Dim sRes As String

Private Sub Command1_Click()
'Dim sRes As String

Winsock1.RemotePort = 25
Winsock1.RemoteHost = frmOptions.txtSMPT_Host
Winsock1.Connect

Status.Caption = ("Connecting to " & frmOptions.txtSMPT_Host & "Hold...")
Do Until Winsock1.State = 7 '7=connected


DoEvents
Loop
sRes = "0"
Winsock1.SendData "MAIL FROM: " & txtMail_From

Status.Caption = "Sending Data 1/3"
Do Until sRes = "250"


DoEvents
Loop
sRes = "0"
Winsock1.SendData "RCPT TO: " & txtrcpt_to

Status.Caption = "Sending Data 2/3"
Do Until sRes = "250"


DoEvents
Loop
sRes = "0"
Winsock1.SendData "DATA" & vbCrLf

Status.Caption = "Sending Data 3/3"
Do Until sRes = "354"


DoEvents
Loop
Winsock1.SendData "FROM: " & txtFrom
Winsock1.SendData "SUBJECT: " & txtSubject
Winsock1.SendData Text1.Text & vbCrLf & "." & vbCrLf
Status.Caption = "Sending Data -> Mass"

Do Until sRes = "250"


DoEvents
Loop
Winsock1.Close
Status.Caption = ("Mail sent to" & txtMail_To.Text & "@ " & txtrcpt_to.Text & "Successful")
End Sub



Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim DATA As String
Dim Length As Long
Winsock1.GetData DATA
Length = Len(DATA)
sRes = Left$(DATA, 3)
End Sub

[usaf002]

It still dosent work, any other suggestions?

[Thread1]

Well it seems that we have forgotten something after the connection portion. Supposedly, the email server should send us the banner or some replies right after the we have had connected which should be in the DataArrival event of the socket. Although, the code in this event is not complete and does not comply with the RFC, even the synchronization is light. Anyways, let's make the code works

Now add the loop that will synchronize us from the server, right after connection:

Status.Caption = ("Connecting to " & frmOptions.txtSMPT_Host & "Hold...")

Do Until Winsock1.State = 7 '7=connected
DoEvents
Loop

'Wait for some reply from the server (banner)
sRes = ""
Do until sRes <> ""
Doevents
Loop
.
.
.

[Thread1]

And be sure that all the information you'll enter is correct and that exists - sender, recipients, etc..

[WizBang]

OK. I put this together to show how it can be done with winsock. Don't forget to customize the strings for your account and server

Dim UserName$, UserMail$, MailRecipiant$, MailBody$, SockData$

Private Sub Command1_Click()
UserName = "YourUserName_or_Addr"
UserMail = "Your Name <You@provider.com>"
MailRecipiant = UserMail
MailBody = "The message goes here"
Winsock1.LocalPort = 0
Winsock1.RemoteHost = "smtp-server"
Winsock1.RemotePort = 25
Winsock1.Connect
End Sub

Private Sub Winsock1_Connect()
Label1 = "Sending message..."
Winsock1.SendData "EHLO " & UserName & vbCrLf
If Not WaitFor("250") Then GoTo 100
Winsock1.SendData "MAIL FROM: " & UserMail & vbCrLf
If Not WaitFor("250") Then GoTo 100
Winsock1.SendData "RCPT TO: " & MailRecipiant & vbCrLf
If Not WaitFor("250") Then GoTo 100
Winsock1.SendData "DATA" & vbCrLf
If Not WaitFor("354") Then GoTo 100
Winsock1.SendData MailBody & vbCrLf & "." & vbCrLf
If Not WaitFor("250") Then GoTo 100
Winsock1.SendData "QUIT" & vbCrLf
If Not WaitFor("221") Then GoTo 100
Label1 = "Message sent"
GoTo 200
100
Label1 = SockData
200
Winsock1.Close
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Winsock1.GetData SockData
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)
Label1 = "Error: " & Description
SockData = "Error"
Winsock1.Close
End Sub

Private Function WaitFor(SockResponse As String) As Boolean
Do While Left(SockData, 3) <> SockResponse And Left(SockData, 3) <> "220" And Left(SockData, 3) <> "250"
  DoEvents
  If Left(SockData, 3) > "400" Then Exit Function
Loop
WaitFor = 1
SockData = ""
End Function

That should do the trick.

[usaf002]

Thanks!!
Works GREAT!

[Thread1]

There you go! Nice job WizBang!

[jusio]

Hi, I've tried to get the sms winsock to work but for some reasons it didn't work. So I was wondering if you could send me a copy of your code that you've got it working. Thanks! (my email add: jusio2@hotmail.com)

[mohsinzahoor]

OK. I put this together to show how it can be done with winsock. Don't forget to customize the strings for your account and server

Dim UserName$, UserMail$, MailRecipiant$, MailBody$, SockData$

Private Sub Command1_Click()
UserName = "YourUserName_or_Addr"
UserMail = "Your Name <You@provider.com>"
MailRecipiant = UserMail
MailBody = "The message goes here"
Winsock1.LocalPort = 0
Winsock1.RemoteHost = "smtp-server"
Winsock1.RemotePort = 25
Winsock1.Connect
End Sub

Private Sub Winsock1_Connect()
Label1 = "Sending message..."
Winsock1.SendData "EHLO " & UserName & vbCrLf
If Not WaitFor("250") Then GoTo 100
Winsock1.SendData "MAIL FROM: " & UserMail & vbCrLf
If Not WaitFor("250") Then GoTo 100
Winsock1.SendData "RCPT TO: " & MailRecipiant & vbCrLf
If Not WaitFor("250") Then GoTo 100
Winsock1.SendData "DATA" & vbCrLf
If Not WaitFor("354") Then GoTo 100
Winsock1.SendData MailBody & vbCrLf & "." & vbCrLf
If Not WaitFor("250") Then GoTo 100
Winsock1.SendData "QUIT" & vbCrLf
If Not WaitFor("221") Then GoTo 100
Label1 = "Message sent"
GoTo 200
100
Label1 = SockData
200
Winsock1.Close
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Winsock1.GetData SockData
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)
Label1 = "Error: " & Description
SockData = "Error"
Winsock1.Close
End Sub

Private Function WaitFor(SockResponse As String) As Boolean
Do While Left(SockData, 3) <> SockResponse And Left(SockData, 3) <> "220" And Left(SockData, 3) <> "250"
  DoEvents
  If Left(SockData, 3) > "400" Then Exit Function
Loop
WaitFor = 1
SockData = ""
End Function

That should do the trick.

I have done this,but still unable to send mail.
have some other solution,I have also tried mapi,it runs OK,no error msg,but I cant accept mail,and after some time My Mcfee showed that a mail is beaing send,but next to it,it also showed PROTOCOL ERROR.
help me out plz...

[WizBang]

I have done this,but still unable to send mail.
have some other solution,I have also tried mapi,it runs OK,no error msg,but I cant accept mail,and after some time My Mcfee showed that a mail is beaing send,but next to it,it also showed PROTOCOL ERROR.
help me out plz...

It may be that your McAfee is preventing the mail from being sent. Usually such applications have a way of setting them to allow certain apps to make outgoing connections. However, That may only work once you compile the program, so while in the IDE you might have to set it to allow VB6 to send. If you want, show the code you are using for sending with winsock. There may be something that can be changed to get it working, though you won't make it send without McAFee knowing about it.