ارسال ایمیل با فایل ضمیمه

[barnamenevisjavan]

سلام کسی سورس کد ارسال ایمیل بهمراه فایل ضمیمه رو داره؟
میخوام وقتی برنامه اجرا شد و کاربر کلیک کرد یه فایل متنی که در کنار فایل اجرایی قرار داره خودش اتچ بشه و ایمیل ارسال بشه

[Hashemvp]

دوست عزیز توی فروم جستجو کنی هست

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

[elimiz]

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

[Hashemvp]

دوست عزیز اینم ی سورس کامل ارسال ایمیل با فایل ضمینه
http://uploadtak.com/images/d4937_SendMail.zip
موفق باشید

[elimiz]

فایل ضمیمه نمیکنه

[arash020]

سلام
این سورس ارسال ایمیل
وقت اتچ نداشتم...ببخشید
با وینسوک کار میکنه باید اد بشه به فرم
دریافت هم میکنه...

' In general Declarations
Dim received As Boolean
Dim Message$
Dim sckError
Dim received2 As Boolean


Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Winsock1.GetData Message$

Select Case Winsock1.Tag
Case "RETR"
Put #1, , Message$

If InStr(Message$, vbLf + "." + vbCrLf) Then
Close 1
received = True
End If

Case Else
sckError = (Left$(Message$, 3) = "-ER")
received = True
End Select
End Sub

Private Sub Winsock1_Close()
Winsock1.Close
End Sub

Private Sub cmdCheckMail_Click()
' LogIn to the server ~ get settings from outlook express
Winsock1.Connect "pop.freeserve.net", 110

Do Until received: DoEvents: Loop

If sckError Then MsgBox "An error occured trying to connect to server": Exit Sub

sendMsg "USER username" ' Send UserName
If sckError Then MsgBox "Error with username": Exit Sub

sendMsg "PASS password" ' Send Password
If sckError Then MsgBox "Error with password": Exit Sub


' Get Number of Messages and total size in bytes
sendMsg "STAT"
x = InStr(Message$, " "): b = InStrRev(Message$, " ")
Messages = Val(Mid$(Message$, x + 1, b - x))
Size = Val(Mid$(Message$, b + 1))

MsgBox "Number of messages to download " & Messages

' Download all messages
For a = 1 To Messages

' Winsock1_DataArrival will save message as "Email-1.eml", "Email-2.eml" etc
Winsock1.Tag = "RETR"
Open "C:\Windows\Temp\eMail-" & a & ".eml" For Binary Access Write As #1

sendMsg "RETR " & a
List1.AddItem "eMail " & a & ": Downloaded"
Next

Winsock1.Tag = ""
End Sub

Sub sendMsg(m$)
Winsock1.SendData m$ + vbCrLf

received = False
Do Until received
DoEvents
Loop
End Sub
'/////////////////////////////////////////////////////////
Private Sub Command1_Click()
sFrom$ = "Jack@hammer.net"
sTo$ = "zombie@freakys.fsnet.co.uk"
sSubject$ = "Hello Mary"
sMessage$ = "This is a simple Message"

' need SMTP server to route message thru, 25 (SMTP)
Winsock2.Connect "smtp.freeserve.net", 25

Do While Winsock2.State <> sckConnected: DoEvents: Loop


sendMsg "HELO " & "Peaches"
sendMsg "MAIL FROM: <" & sFrom & ">"
sendMsg "RCPT TO: <" & sTo & ">"
sendMsg "DATA"


m$ = m$ + "From: <" + sFrom + ">" + vbCrLf
m$ = m$ + "To: <" + sTo + ">" + vbCrLf
m$ = m$ + "Subject: " + sSubject$ + vbCrLf
m$ = m$ + "Date: " + Format$(Now, "h:mm:ss") + vbCrLf
m$ = m$ + "MIME-Version: 1.0" + vbCrLf
m$ = m$ + "Content-Type: text/plain; charset=us-ascii" + vbCrLf + vbCrLf

m$ = m$ + sMessage$ + vbCrLf + vbCrLf + "." + vbCrLf

sendMsg m$ + "QUIT"

Winsock2.Close
End Sub

Private Sub Winsock2_DataArrival(ByVal bytesTotal As Long)
received2 = True
End Sub

Sub sendMsg2(m$)
Winsock2.SendData m$ + vbCrLf

received2 = False
Do Until received2
DoEvents
Loop
End Sub

[Hashemvp]

فایل ضمیمه نمیکنه

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

Flds.Item(schema & "smtpserver") = "smtp.gmail.com"
Flds.Item(schema & "smtpserverport") = 465

موفق باشید

[arash020]

SmtpServer.Port =587
"SmtpServer.Host = "smtp.gmail.com