Sending E_mails With Winsock

السلام عليكم ...

اخي الكريم Rachid Abdallah لقد قمت بعمل بحث عن سؤالك و يمكنك ان تختار اي برنامج من الوصلة التالية ..

ناتج البحث

بنت اليمن ،،

السلام عليكم

انشئ مشروع جديد وقم بوضع الادوات التالية :

1- زر أمر

2- أدواة عنوان (Label) بأسم StatusTxt

3- أداة تقدم (ProgressBar) بالاسم الافتراضي ProgressBar1

4- أداة Winsock باسم Winsock2

ثم ألصق هذا الكود في Form1 في قسم التعرفات Declarations

Dim Response As String, Reply As Integer, DateNow As String
Dim first As String, Second As String, Third As String
Dim Fourth As String, Fifth As String, Sixth As String
Dim Seventh As String, Eighth As String, Ninth As String
Dim start As Single, Tmr As Single

ثم في نفس الـForm الصق الكود التالي :

Sub SendEmail(MailServerName As String, FromName As String, FromEmailAddress As String, ToName As String, ToEmailAddress As String, EmailSubject As String, EmailBodyOfMessage As String)
  On Error GoTo ErrorHandler
  
    Winsock2.LocalPort = 0 ' Must set local port to 0 (Zero) or you can only send 1 e-mail pre program start
    
If Winsock2.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) + ToEmailAddress + vbCrLf ' Who it going to
    Sixth = "Subject:" + Chr(32) + EmailSubject + vbCrLf ' Subject of E-Mail
    Seventh = EmailBodyOfMessage + vbCrLf ' E-mail message body
    Ninth = "X-Mailer: EBT Reporter v 2.x" + vbCrLf ' What program sent the e-mail, customize this
    Eighth = Fourth + Third + Ninth + Fifth + Sixth  ' Combine for proper SMTP sending

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

    WaitFor ("250")

    StatusTxt.Caption = "Connected"
    StatusTxt.Refresh
 ProgressBar1.Value = 25
    Winsock2.SendData (first)

    StatusTxt.Caption = "Sending Message ..."
    StatusTxt.Refresh

    WaitFor ("250")

    Winsock2.SendData (Second)

    WaitFor ("250")
 ProgressBar1.Value = 50

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


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

    WaitFor ("250")
 ProgressBar1.Value = 75
    Winsock2.SendData ("quit" + vbCrLf)
     ProgressBar1.Value = 100
    StatusTxt.Caption = "Disconnecting ..."
    StatusTxt.Refresh

    WaitFor ("221")

    Winsock2.Close
     ProgressBar1.Value = 0
Else
    StatusTxt.Caption = (Str(Winsock2.State))
End If

ErrorHandler:
 ProgressBar1.Value = 0
 StatusTxt.Caption = "Error Call: " & Err
End Sub

'------------------------------------- Wating 
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 "Server is Not Responding", 64
            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
            Exit Sub
        End If
    Wend
Response = "" ' Sent response code to blank **IMPORTANT**
End Sub
'------------------------ Data arrival
Private Sub winsock2_DataArrival(ByVal bytesTotal As Long)

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

End Sub

ثم في زر الامر ضع الكود التالي ، مع تغيير البيانات في الدالة

    SendEmail "your mail server", "youName", "Your Email", "Recipient Name ", "Recipient Email", "Subject", "Mail Bodey"

تحياتي لك ، :)