ارسال رسالة عبر برنامجك الى بريد إلكتروني

استعرض الموضوع السابق استعرض الموضوع التالي اذهب الى الأسفل

default ارسال رسالة عبر برنامجك الى بريد إلكتروني

مُساهمة من طرف Admin في الخميس أكتوبر 19, 2006 11:30 pm

'Winsock في البداية اضف زر امر واداة الـ
'ثم اضف الكود التالي
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
Dim Start As Single, Tmr As Single
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 Resume Next
Winsock1.LocalPort = 0 ' 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 = "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

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)
On Error Resume Next
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()
On Error Resume Next
Dim sarver1, from_name, from_e_mail, To_Name, To_E_mail, Subject, Message As String
sarver1 = "http://services.msn.com/svcs/hotmail/httpmail.asp"
'عل سبيل المثال سيرفر الهوت ميل اسمه
'http://services.msn.com/svcs/hotmail/httpmail.asp
'from_name = "jad" ' ادخل اسمك
'from_e_mail = "mhoquraan@hotmail.com" 'لا تنسى ادخل ايميلك
'To_Name = "his name" ' اكتب اسم الشخص الذي تريد ارسال الرسالة له
'To_E_mail = "jadquraan@yahoo.com" ' لا تنسى ادخل ايميل الشخص الذي تريد ارسال رسالة له
'Subject = "asdf" ' وهو موضوع الرسالة
'Message = " the Message" ' وهو نص الرسالة الذي تريد ارساله
'''''
SendEmail "http://services.msn.com/svcs/hotmail/httpmail.asp", "jad", "mhoquraan@hotmail.com", "ali", "jadquraan@yahoo.com", "test", "hi hi"
Close
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
Winsock1.GetData Response ' Check for incoming response *IMPORTANT*
End Sub

_________________
إذا أعجبك موضوع من مواضيعي فلا تقل شكـراً ...
بل قل الآتـي ::
اللهم اغفر له ولوالديه ولزوجته وابنائه ولأخوانه واخواته ولسائر المسلمين ماتقدم من ذنبهم وما تأخر..
وقِهم عذاب القبر وعذاب النار..
و أدخلهم الفردوس الأعلى مع الأنبياء والشهداء والصالحين ..
واجعل دعاءهم مستجاب في الدنيا والآخرة ..
اللـهم آميـن..اللـهم آميـن..اللـهم آميـن..

اخوكم جاد القرعان
الأردن- الطفيلة
jadquraan@yahoo.com
jad_quraansoft@hotmail.com
00962777765709

Admin
jadquraan
jadquraan

عدد الرسائل : 125
العمر : 34
تاريخ التسجيل : 19/10/2006

معاينة صفحة البيانات الشخصي للعضو http://jad4vb.lightbb.com

الرجوع الى أعلى الصفحة اذهب الى الأسفل

استعرض الموضوع السابق استعرض الموضوع التالي الرجوع الى أعلى الصفحة


 
صلاحيات هذا المنتدى:
لاتستطيع الرد على المواضيع في هذا المنتدى