-
February 23rd, 2003, 06:10 PM
#1
Making me Mad!
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*
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!!
-
February 23rd, 2003, 09:49 PM
#2
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.
Busy
-
February 23rd, 2003, 10:25 PM
#3
i dont know anything about it sry!
"3 out of every 4 people make up 75% of the population"
---------------------------------------------
"If the World didn't suck, we would all fall off"
---------------------------------------------
"No pancake is so flat that it doesnt have two sides"
---------------------------------------------
-
February 24th, 2003, 12:32 AM
#4
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
Busy
-
February 25th, 2003, 04:32 PM
#5
It still dosent work, any other suggestions?
-
February 25th, 2003, 09:23 PM
#6
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
.
.
.
Busy
-
February 25th, 2003, 09:28 PM
#7
And be sure that all the information you'll enter is correct and that exists - sender, recipients, etc..
Last edited by Thread1; February 25th, 2003 at 09:31 PM.
Busy
-
February 26th, 2003, 07:39 AM
#8
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
Code:
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.
-
February 26th, 2003, 07:16 PM
#9
Thanks!!
Works GREAT!
-
February 26th, 2003, 11:46 PM
#10
There you go! Nice job WizBang!
Busy
-
July 18th, 2003, 07:46 PM
#11
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)
Last edited by jusio; July 18th, 2003 at 08:05 PM.
-
February 3rd, 2006, 11:35 AM
#12
Re: Making me Mad!
Originally Posted by 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
Code:
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...
-
February 3rd, 2006, 03:50 PM
#13
Re: Making me Mad!
Originally Posted by mohsinzahoor
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.
Please remember to rate the posts and threads that you find useful.
How can something be both new and improved at the same time?
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|