نرم افزار ارسال ایمیل از طریق smtp

[hackershz]

سلام و خسته نباشید به دوستان عزیز


بنده نیاز به نرم افزاری دارم که متن html رو بفرسته و به اس ام تی پی های مختلف وصل بشه

توی تالار و اینترنت سرچ کردم متاسفانه هیچ کدام از برنامه ها کار نمیکنند


اگر هزینه ای هم داره پرداخت میکنم یه چیز خوب و کامل میخوام که بتونم ویرایشش کنم

[meys34]

سورس ارسال ایمیل که فراوون تو سایتمون هم هست...
برای ارسال متن html فقط باید دقت کنید که متن رو توی قسمت htmlbody بزارید نه توی قسمت TextBody
منظورم خط 47 و 48 کد پایین هست...


نکته اش اینجاست که:

مشکلی که هست اینه که ایمیل های معتبر موقع نمایش متن html ،برای بالا بردن امنیت،
فقط قسمت های قابل چاپ رو نمایش میدن...

منظورم اینه که قسمت های مهمی نظیر کد های جاوا اسکریپت غیر فعال خواهند بود...



خودم امتحان کردم از طریق سایت یاهو کد جاوا اجرا نشد... ولی
از طریق موبایلم کد جاوا به درستی اجرا شد...






به هر حال:
این سورس تکراری رو یکمی تغییر دادم تا هم فارسی رو ساپورت کنه و هم با smtp یاهو درست کار بکنه:

در ضمن به دلیل تنظیمات امنیتی جیمیل، برای استفاده از کد زیر، باید توی کنترل پنل جیمیل گزینه Modern Security رو غیر فعال کنید...
Public Function SendMail(ByVal sMailSender As String, _
ByVal sMailSenderPassword As String, _
ByVal sMailSubject As String, _
ByVal sMailReciever As String, _
ByVal sMailText As String, _
Optional ByVal sMailAttachFile As String) As String

On Error GoTo EndLine
Dim obMsg As Object
Dim obConf As Object
Dim Flds As Object
Dim strSchema As String


If sMailSender = vbNullString Or sMailSenderPassword = vbNullString Then
GoTo EndLine
End If

Set obMsg = CreateObject("CDO.Message")
Set obConf = CreateObject("CDO.Configuration")
Set Flds = obConf.Fields



' send one copy with Google SMTP server (with autentication)
strSchema = "http://schemas.microsoft.com/cdo/configuration/"
Flds.Item(strSchema & "sendusing") = 2
Flds.Item(strSchema & "smtpserver") = "smtp." & Mid$(sMailSender, 1 + InStr(1, sMailSender, "@"))

If LCase(Mid$(sMailSender, 1 + InStr(1, sMailSender, "@"))) = "yahoo.com" Then
Flds.Item(strSchema & "smtpserver") = "smtp.mail.yahoo.co.uk"
End If

Flds.Item(strSchema & "smtpserverport") = 465
Flds.Item(strSchema & "smtpauthenticate") = 1
Flds.Item(strSchema & "sendusername") = sMailSender
Flds.Item(strSchema & "sendpassword") = sMailSenderPassword
Flds.Item(strSchema & "smtpusessl") = 1
Flds.Item(strSchema & "cdoSMTPConnectionTimeout") = 5
Flds.Update

With obMsg
.To = sMailReciever
.From = sMailSender
.Subject = sMailSubject

.htmlbody = "<meta http-equiv=""Content-Type"" content=""text/html; charset=utf-8"">" & sMailText
' .TextBody = sMailText

.BodyPart.Charset = "utf-8"
.TextBodyPart.Charset = "utf-8"
.HTMLBodyPart.Charset = "utf-8"

' .Sender = sMailSender
' .Organization = "S.M.B Productions"
.ReplyTo = sMailSender
If sMailAttachFile <> vbNullString Then
.AddAttachment (sMailAttachFile)
End If
Set .Configuration = obConf
.Send
End With

SendMail = "Message Sent!"
Set obMsg = Nothing
Set obConf = Nothing
Set Flds = Nothing
Exit Function

EndLine:
Set obMsg = Nothing
Set obConf = Nothing
Set Flds = Nothing
SendMail = Err.Description
End Function

[hackershz]

داداش ممنونم امکانش هست توی یک پروژه برای من مثال بزنی ؟

ممنونم

[meys34]

بفرمایید اینم نمونه

[hackershz]

قربان دست شما درد نکنه اگر امکانش هست پیغام خصوصیتون رو چک کنید اگر هم دریافت نکردید لطفا ایمیلتون رو بدید بنده یه پیغام خصوصی ارسال کردم

با تشکر

[hackershz]

جناب meys34 (http://barnamenevis.org/member.php?72486-meys34) ببخشید خیلی زحمت بهتون دادم

اگ بخوایم مثلا 10 سرور اضافه کنیم و 10 سرور مختلف باشند ولی همشون از یک سیستم استفاده کنند و از نظر امنیت و... هم یکی باشند باید چه کار کنیم ؟

مثلا بخوایم هر سری هر 2 ثانیه یک ایمیل بفرسته و بره سرور بعدی اتوماتیک ؟