السلام عليكم ورحمة الله وبركاته
من منكم يا اخوة يعرف ماهو الكود أو ماهي الأداة
من أجل ارسال رسالة من إيميل وهمي أو من دون إيميل ( من شخص مجهول )
أرجو الرد السريع جزاكم الله خيراً.
السلام عليكم ورحمة الله وبركاته
من منكم يا اخوة يعرف ماهو الكود أو ماهي الأداة
من أجل ارسال رسالة من إيميل وهمي أو من دون إيميل ( من شخص مجهول )
أرجو الرد السريع جزاكم الله خيراً.
link=#186cbe text=#ffffff vLink=#f3dd5d>
To:
Subject:
Message:
size=6>l.n.t@maktoob.com
face="Times New Roman" size=6>عوده
[an erroroccurred while processing this directive]
طبعا انا لم انسى الموضوع وان شاء الله اذا امكن سوف اضع الكود
وان شاء الله يكون قريب
والله ولى التوفيق
;)
هذا الملف نزلته من وصلة وجدتها في هذا المنتدي ولكني لااذكر عنوانها
ارجو ان يكون هو المطلوب
اداة ocx لإرسال البريد الإلكترونى
حمل الاداة من هنا
http://www.geocities.com/proprogram/d/ocx-sendmail.zip
ملاحظة:
اضغط بزر الماوس الايمن على الرابط ثم اختر حفظ الهدف باسم Save target as
أخي Abdullah Mostafa الملف حجمه 0 بايت ولا يحتوي على شئ أرجو أن تضع غير وصلة.
أخي prokhaled هذا تماماً ما أبحث عنه لكن هذه الأداة عندي وهناك أمران:
1- هذه الأداة النسخة Demo وأنا أريدها كاملة فهي سوف تتوقف بعد ثلاثة أشهر.
2- جربتها عندي ولم تعمل.
أرجو أن تضع غيرها إن كان لديك.
جزاكم الله خيراً...وشكراً لمساعدتكم
أخي حسين أرجو من الله العليّ القدير أن تكون قد وجدت ما أريد.
وآمل أن تضع الكود بأسرع ما أمكن.
يا اخوة وجدت هذا الكود لارسال رسالة من مصدر مجهول
لكن المشكلة لم أعرف الأدوات المطلوبة
أرجو ممن يتمكن من عمل مشروع جاهز بهذا الكود مع الأدوات أن يضعه لنا مشكوراً.
هذا الكود لارسال رسأل من مصدر مجهول
الأدوات:
text box- 6
com-2
winsock-3
وهناك أدوات أخرى مستخدمة.
الكود :
Private emailhost As String
Private emailto As String
Private emailfrom As String
Private emailmessage As String
Private emailsubject As String
Dim cmdat As Integer
Dim reply1, InData As String
Private Sub Com1_Click()
emailstatus = ""
emailhost = Text1.Text
emailfrom = Text3.Text
emailto = Text2.Text
emailsubject = Text4.Text
emailmessage = Text5.Text
If emailsock.State <> sckClosed Then
emailsock.Close
End If
emailsock.RemotePort = 25
emailsock.RemoteHost = emailhost
emailsock.Connect
Com1.Enabled = False
End Sub
Private Sub Command1_Click()
emailsock.Close
Com1.Enabled = True
End Sub
Private Sub ConnectionTimeout_Timer()
If emailsock.State <> 7 Then
emailsock.Close
End If
End Sub
Private Sub txtadd(txt2add As String)
emailstatus.Text = emailstatus.Text & vbCrLf & txt2add
emailstatus.SelStart = Len(emailstatus.Text)
End Sub
Private Sub emailsock_Connect()
cmdat = 0
End Sub
Private Sub emailSock_DataArrival(ByVal bytesTotal As Long)
emailsock.GetData InData
reply1 = Mid(InData, 1, 3)
If reply1 = "250" Then
cmdat = cmdat + 1
End If
If reply1 = "220" Then
cmdat = cmdat + 1
End If
If reply1 = "354" Then
cmdat = cmdat + 1
End If
If Left(reply1, 1) = "5" Then
txtadd "*** ERROR ***"
Command1_Click
End If
txtadd InData
emailstat
End Sub
Private Sub emailstat()
On Error Resume Next
If cmdat = 7 Then
Exit Sub
ElseIf cmdat = 1 Then
emailsock.SendData "HELO my friend ...." & vbNewLine
ElseIf cmdat = 2 Then
emailsock.SendData "MAIL FROM: " & emailfrom & vbNewLine
ElseIf cmdat = 3 Then
emailsock.SendData "RCPT TO: " & emailto & vbNewLine
If Err Then
Command1_Click
Exit Sub
End If
ElseIf cmdat = 4 Then
emailsock.SendData "DATA" & vbNewLine
ElseIf cmdat = 5 Then
Dim MSG As String
MSG = "From: " & emailfrom & vbNewLine & _
"To: " & emailto & vbNewLine & _
"Subject: " & emailmessage & vbNewLine & vbNewLine & _
emailmessage & vbNewLine & "." & vbNewLine
emailsock.SendData MSG
ElseIf cmdat = 6 Then
emailsock.SendData "QUIT" & vbNewLine
Com1.Enabled = True
txtadd "*** Message sent! ***"
End If
End Sub
أرجو وضع المشروع لمن يتمكن من تظبيت هذا الكود.
قم بإضافة كوماند بوتن
com1
command1
وإضافة كنترول Winsock
وخل اسمه = emailsock
وخمسه تكست بوكس وتسمياهم موجوده في الكود
عسا ان اكون نفعتك في شيء بسيط
والله الموفق
Private emailhost As String Private emailto As String Private emailfrom As String Private emailmessage As String Private emailsubject As String Dim cmdat As Integer Dim reply1, InData As String Private Sub Com1_Click() emailstatus = "" emailhost = Text1.Text emailfrom = Text3.Text emailto = Text2.Text emailsubject = Text4.Text emailmessage = Text5.Text If emailsock.State <> sckClosed Then emailsock.Close End If emailsock.RemotePort = 25 emailsock.RemoteHost = emailhost emailsock.Connect Com1.Enabled = False End Sub Private Sub Command1_Click() emailsock.Close Com1.Enabled = True End Sub Private Sub ConnectionTimeout_Timer() If emailsock.State <> 7 Then emailsock.Close End If End Sub Private Sub txtadd(txt2add As String) emailstatus.Text = emailstatus.Text & vbCrLf & txt2add emailstatus.SelStart = Len(emailstatus.Text) End Sub Private Sub emailsock_Connect() cmdat = 0 End Sub Private Sub emailSock_DataArrival(ByVal bytesTotal As Long) emailsock.GetData InData reply1 = Mid(InData, 1, 3) If reply1 = "250" Then cmdat = cmdat + 1 End If If reply1 = "220" Then cmdat = cmdat + 1 End If If reply1 = "354" Then cmdat = cmdat + 1 End If If Left(reply1, 1) = "5" Then txtadd "*** ERROR ***" Command1_Click End If txtadd InData emailstat End Sub Private Sub emailstat() On Error Resume Next If cmdat = 7 Then Exit Sub ElseIf cmdat = 1 Then emailsock.SendData "HELO my friend ...." & vbNewLine ElseIf cmdat = 2 Then emailsock.SendData "MAIL FROM: " & emailfrom & vbNewLine ElseIf cmdat = 3 Then emailsock.SendData "RCPT TO: " & emailto & vbNewLine If Err Then Command1_Click Exit Sub End If ElseIf cmdat = 4 Then emailsock.SendData "DATA" & vbNewLine ElseIf cmdat = 5 Then Dim MSG As String MSG = "From: " & emailfrom & vbNewLine & _ "To: " & emailto & vbNewLine & _ "Subject: " & emailmessage & vbNewLine & vbNewLine & _ emailmessage & vbNewLine & "." & vbNewLine emailsock.SendData MSG ElseIf cmdat = 6 Then emailsock.SendData "QUIT" & vbNewLine Com1.Enabled = True txtadd "*** Message sent! ***" End If End Sub
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)
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 = "mouse mailer" + 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)
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.Text, txtFromName.Text, txtFromEmailAddress.Text, txtToEmailAddress.Text, txtToEmailAddress.Text, txtEmailSubject.Text, txtEmailBodyOfMessage.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حمل الاصدار الجديد من على نفس الرابط
اضغط بزر الماوس الايمن و اختار حفظ الهدف باسم
كيف حالكم شباب الله يعطيكم العافيه
ماشاء الله عليكم
اضغط بزر الماوس الايمن و اختار حفظ الهدف باسم
والله ولى التوفيق
;)
شكراً لكم يا اخوة على ما بذلتوه من جهد
أخي حسين شكراً لك على البرنامج
لكنه لم يعمل أرسلت رسالة بواسطته ولم تصل
هل يشترط أن يكون هناك حساب في Outlook Express ؟؟؟
كتب اسم المرسل وبريده واسم المرسل إليه وبريده والعنوان وص الرسالة لكن لم تصل. فما هو السبب ؟؟؟؟ أرجو التوضيح.
عزيزي عبدالغنى في الكود نفسه عليك بكتابة احد السرفرات الداعمة
مثل mail.hotmail.com
وهذا البرنامج كامل عسى الله يوفقك لكل خير خاصتا ضد اليهود
والله الموفق
;)
عزيزي حسين معليش تحملني قليلاً
أنت جربت البرنامج
أرسلت رسالة من البرنامج الجديد ولم تصل.
ما هو السبب؟؟؟
كيف حالك عبد الغني ؟
أذا كنت تستخدم الهوتميل فالرسالة تذهب JUNK MAIL
جرب فتح جانك مايل وخبرني عن النتيجة ؟
أخوك حسين عبالله
;)
والله ولي التوفيق
أخي الكريم لم أفهم عليك.
إليك ما قمت بعمله:
كتبت في TO agmsoft@scs-net.org
وفي From ss@hotmail.com
والسيرفر mail.hotmail.com
ووضعت عنوان ونص للرسالة
ووضعت الخيار Normal
وضغطت Send
ثم فتحت البريد agmsoft@scs-net.org
ولم أجد أي رسالة.
هذا أيميلي hussein979@hotmail.com
أضفني عندك حتى يمكنني مساعدتك
وسوف اقوم لاحقا بشرح البرنامج
وشكرا
والله ولي التوفيق
;)
عزيزي حسين وأنا هذا ايميلي
أرجو أن ترسل لي الشرح بأسرع وقت ممكن أخي الكريم
جزاك الله خيراً على مجهودك الرائع الذي لا ينسى
هذا الموضوع مغلق.