الفريق العربي للبرمجةأرشيف المنتديات · 2000 – 2023
نسخة أرشيفية للقراءة فقط — التسجيل والمشاركة مغلقان، والمحتوى محفوظ كما كان.

كود ارسال رسالة

مغلق
بدأه عبد الغني محسن في 8 مايو 2002 · 20 رد · 2,777 مشاهدة · في لغة Ms Visual Basic 6 وما قبلها من إصدارات
مشاركة: واتساب X فيسبوك تيليجرام
#1 صاحب الموضوع

السلام عليكم ورحمة الله وبركاته

من منكم يا اخوة يعرف ماهو الكود أو ماهي الأداة

من أجل ارسال رسالة من إيميل وهمي أو من دون إيميل ( من شخص مجهول )

أرجو الرد السريع جزاكم الله خيراً.

#3

link=#186cbe text=#ffffff vLink=#f3dd5d>

 

إرســـــال رســــــــاله

مجهــــــــوله

 

 

 

To:

Subject:

Message:

size=6>l.n.t@maktoob.com

face="Times New Roman" size=6>عوده

[an error

occurred while processing this directive]

#4

طبعا انا لم انسى الموضوع وان شاء الله اذا امكن سوف اضع الكود

وان شاء الله يكون قريب

والله ولى التوفيق

;)

#5

هذا الملف نزلته من وصلة وجدتها في هذا المنتدي ولكني لااذكر عنوانها

ارجو ان يكون هو المطلوب

#6

اداة ocx لإرسال البريد الإلكترونى

حمل الاداة من هنا

http://www.geocities.com/proprogram/d/ocx-sendmail.zip

ملاحظة:

اضغط بزر الماوس الايمن على الرابط ثم اختر حفظ الهدف باسم Save target as

#7

أخي Abdullah Mostafa الملف حجمه 0 بايت ولا يحتوي على شئ أرجو أن تضع غير وصلة.

أخي prokhaled هذا تماماً ما أبحث عنه لكن هذه الأداة عندي وهناك أمران:

1- هذه الأداة النسخة Demo وأنا أريدها كاملة فهي سوف تتوقف بعد ثلاثة أشهر.

2- جربتها عندي ولم تعمل.

أرجو أن تضع غيرها إن كان لديك.

جزاكم الله خيراً...وشكراً لمساعدتكم

#9

أخي حسين أرجو من الله العليّ القدير أن تكون قد وجدت ما أريد.

وآمل أن تضع الكود بأسرع ما أمكن.

#10

يا اخوة وجدت هذا الكود لارسال رسالة من مصدر مجهول

لكن المشكلة لم أعرف الأدوات المطلوبة

أرجو ممن يتمكن من عمل مشروع جاهز بهذا الكود مع الأدوات أن يضعه لنا مشكوراً.

هذا الكود لارسال رسأل من مصدر مجهول

الأدوات:

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

أرجو وضع المشروع لمن يتمكن من تظبيت هذا الكود.

#11

قم بإضافة كوماند بوتن

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
#12
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
#13

حمل الاصدار الجديد من على نفس الرابط

اضغط بزر الماوس الايمن و اختار حفظ الهدف باسم

http://www.geocities.com/proprogram/d/ocx-sendmail.zip

#14

كيف حالكم شباب الله يعطيكم العافيه

ماشاء الله عليكم

اضغط بزر الماوس الايمن و اختار حفظ الهدف باسم

من هنا نزل البرنامج

والله ولى التوفيق

;)

#15

شكراً لكم يا اخوة على ما بذلتوه من جهد

أخي حسين شكراً لك على البرنامج

لكنه لم يعمل أرسلت رسالة بواسطته ولم تصل

هل يشترط أن يكون هناك حساب في Outlook Express ؟؟؟

كتب اسم المرسل وبريده واسم المرسل إليه وبريده والعنوان وص الرسالة لكن لم تصل. فما هو السبب ؟؟؟؟ أرجو التوضيح.

#16

عزيزي عبدالغنى في الكود نفسه عليك بكتابة احد السرفرات الداعمة

مثل mail.hotmail.com

وهذا البرنامج كامل عسى الله يوفقك لكل خير خاصتا ضد اليهود

أستخدم حفظ باسم

والله الموفق

;)

#17

عزيزي حسين معليش تحملني قليلاً

أنت جربت البرنامج

أرسلت رسالة من البرنامج الجديد ولم تصل.

ما هو السبب؟؟؟

#18

كيف حالك عبد الغني ؟

أذا كنت تستخدم الهوتميل فالرسالة تذهب JUNK MAIL

جرب فتح جانك مايل وخبرني عن النتيجة ؟

أخوك حسين عبالله

;)

والله ولي التوفيق

#19

أخي الكريم لم أفهم عليك.

إليك ما قمت بعمله:

كتبت في TO agmsoft@scs-net.org

وفي From ss@hotmail.com

والسيرفر mail.hotmail.com

ووضعت عنوان ونص للرسالة

ووضعت الخيار Normal

وضغطت Send

ثم فتحت البريد agmsoft@scs-net.org

ولم أجد أي رسالة.

#20

هذا أيميلي hussein979@hotmail.com

أضفني عندك حتى يمكنني مساعدتك

وسوف اقوم لاحقا بشرح البرنامج

وشكرا

والله ولي التوفيق

;)

#21

عزيزي حسين وأنا هذا ايميلي

agmsoft@scs-net.org

أرجو أن ترسل لي الشرح بأسرع وقت ممكن أخي الكريم

جزاك الله خيراً على مجهودك الرائع الذي لا ينسى

هذا الموضوع مغلق.

مواضيع مشابهة