سورس email sender با winSock
#1
Note 
کد php:
'you MUST put the Winsock1 control on your form
'
and this will work VERY quickly!!
'heinlein@execpc.com (write me and thank me later! hehe)
'
-I-[]v[]oUsE-I- []nDuSt[]2iEs (C)1999 IDK

Dim Response 
As StringReply As IntegerDateNow As String
Dim first 
As StringSecond As StringThird As String
Dim Fourth 
As StringFifth As StringSixth As String
Dim Seventh 
As StringEighth As String
Dim Start 
As SingleTmr As Single



Sub SendEmail
(MailServerName As StringFromName As StringFromEmailAddress As StringToName As StringToEmailAddress As StringEmailSubject As StringEmailBodyOfMessage As String)
          
    
Winsock1.LocalPort ' Must set local port to 0 (Zero) or you can only send 1 e-mail pre program start
    
If Winsock1.State = sckClosed Then ' 
Check to see if socet is closed
    DateNow 
Format(Date"Ddd") & ", " Format(Date"dd Mmm YYYY") & " " Format(Time"hh:mm:ss") & "" " -0600"
    
first "mail from:" Chr(32) + FromEmailAddress vbCrLf ' Get who's sending E-Mail address
    Second 
"rcpt to:" Chr(32) + ToEmailAddress vbCrLf ' Get who mail is going to
    Third = "Date:" + Chr(32) + DateNow + vbCrLf ' 
Date when being sent
    Fourth 
"From:" Chr(32) + FromName vbCrLf ' Who's Sending
    Fifth 
"To:" Chr(32) + ToNametxt vbCrLf ' Who it going to
    Sixth = "Subject:" + Chr(32) + EmailSubject + vbCrLf ' 
Subject of E-Mail
    Seventh 
EmailBodyOfMessage vbCrLf ' E-mail message body
    Ninth = "mouse mailer" + vbCrLf ' 
What program sent the e-mailcustomize this
    Eighth 
Fourth Third Ninth Fifth Sixth  ' Combine for proper SMTP sending

    Winsock1.Protocol = sckTCPProtocol ' 
Set protocol for sending
    Winsock1
.RemoteHost MailServerName ' Set the server address
    Winsock1.RemotePort = 25 ' 
Set the SMTP Port
    Winsock1
.Connect ' Start connection
    
    WaitFor ("220")
    
    StatusTxt.Caption = "Connecting...."
    StatusTxt.Refresh
    
    Winsock1.SendData ("HELO worldcomputers.com" + vbCrLf)

    WaitFor ("250")

    StatusTxt.Caption = "Connected"
    StatusTxt.Refresh

    Winsock1.SendData (first)

    StatusTxt.Caption = "Sending Message"
    StatusTxt.Refresh

    WaitFor ("250")

    Winsock1.SendData (Second)

    WaitFor ("250")

    Winsock1.SendData ("data" + vbCrLf)
    
    WaitFor ("354")


    Winsock1.SendData (Eighth + vbCrLf)
    Winsock1.SendData (Seventh + vbCrLf)
    Winsock1.SendData ("." + vbCrLf)

    WaitFor ("250")

    Winsock1.SendData ("quit" + vbCrLf)
    
    StatusTxt.Caption = "Disconnecting"
    StatusTxt.Refresh

    WaitFor ("221")

    Winsock1.Close
Else
    MsgBox (Str(Winsock1.State))
End If
   
End Sub
Sub WaitFor(ResponseCode As String)
    Start = Timer ' 
Time event so won't get stuck in loop
    While Len(Response) = 0
        Tmr = Start - Timer
        DoEvents ' 
Let System keep checking for incoming response **IMPORTANT**
        If 
Tmr 50 Then ' Time in seconds to wait
            MsgBox "SMTP service error, timed out while waiting for response", 64, MsgTitle
            Exit Sub
        End If
    Wend
    While Left(Response, 3) <> ResponseCode
        DoEvents
        If Tmr > 50 Then
            MsgBox "SMTP service error, impromper response code. Code should have been: " + ResponseCode + " Code recieved: " + Response, 64, MsgTitle
            Exit Sub
        End If
    Wend
Response = "" ' 
Sent response code to blank **IMPORTANT**
End Sub


Private Sub Command1_Click()
    
SendEmail txtEmailServer.TexttxtFromName.TexttxtFromEmailAddress.TexttxtToEmailAddress.TexttxtToEmailAddress.TexttxtEmailSubject.TexttxtEmailBodyOfMessage.Text
    
'MsgBox ("Mail Sent")
    StatusTxt.Caption = "Mail Sent"
    StatusTxt.Refresh
    Beep
    
    Close
End Sub

Private Sub Command2_Click()
    
    End
    
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

    Winsock1.GetData Response ' 
Check for incoming response *IMPORTANT*

End Sub 

پاسخ
ایجاد موضوع جدید   پاسخ به موضوع  

موضوعات مرتبط با این موضوع...
موضوع نویسنده پاسخ بازدید آخرین ارسال
Note سوال سورس حذف ایمیل و نمایش آی پی و مک آدرس کامپیوتر moeinmq 1 823 24-01-2015 ساعت 18:30
آخرین ارسال: xMAN
Note سوال سورس برنامه افزایش ولتاژ قطعات موردنظر moeinmq 0 699 25-11-2014 ساعت 18:30
آخرین ارسال: moeinmq
Note سورس قطع کردن اتصال به اینترنت با رفرش کردن moeinmq 3 961 14-08-2014 ساعت 20:23
آخرین ارسال: vc3000
Note سورس مقاسیه عدد Daniel 0 355 18-04-2014 ساعت 18:21
آخرین ارسال: Daniel
Note آدرس یاب رایگان + سورس amirali 7 1,746 10-04-2014 ساعت 08:45
آخرین ارسال: AppDev
Note سورس وصل شدن به اینترنت بصورت مخفی moeinmq 1 545 03-12-2013 ساعت 22:18
آخرین ارسال: VBProgrammer
Note سورس کدهای ویژوال بیسیک 6 Daniel 136 20,310 18-11-2013 ساعت 10:38
آخرین ارسال: Daniel
Note سوال: نمایش ایمیل دریافت شده در VB6 moeinmq 4 982 23-09-2013 ساعت 09:36
آخرین ارسال: C0der
Note آموزش کار با کنترل Winsock SOFTAFZAR 2 961 24-06-2013 ساعت 20:47
آخرین ارسال: The Arrow
Note سورس دفترچه تلفن به زبان ویژوال بیسیک Daniel 4 2,717 14-01-2013 ساعت 14:12
آخرین ارسال: Stack OverFlow

کاربرانِ درحال بازدید از این موضوع:   1 مهمان