# Native Code > برنامه نویسی در 6 VB > برنامه نویسی مرتبط با شبکه و وب در VB6 >  ارسال ایمیل 100%  به همراه سورس کامل

## roomezonline

*دوستان اینم یه سورس توپ واسه ارسال 100% ایمیل سالم - برید حالشو ببرید کار خودمه
 سوال یا نقص احتمالی که بعید میدونم در این برنامه باشه اگر بود با من در میان بذارید 3 سوووت حل میکنم*

----------


## saeid12

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

----------


## roomezonline

> نمیخوام از ارزش کارت کم کنم ولی این تو سایت بود
> ولی از ocx هاش استفاده کردم
> ممنون


دوست عزیز میشه مثل همین رو تو همین سایت به من نشون بدید . Thanks

----------


## vahid_d_0101

انتی ویروس من که بهش گیر داد فکر کنم 100 درصد ویروسی هست

----------


## parselearn

فايل exe داخل برنامه ويروسي
فايل فشرده رو باز كنيد و فايل exe رو حذف كنيد

ضمنا roomezonline كامپيوتر شما يا فايلتون  :اشتباه:  ويروسيه

----------


## Tasiyan

من مشکل دارم،مشکلشم تو ماژولت iMsg کار نمیکنه (دات میزنی دستور نمیاره)
نیاز به دی ال ال خاصی هست ؟

----------


## saeedzx

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

 SendEmailGmail = .Send

----------


## Reza_Zeby

*سلام

 ببخشيد من بعد از زدن کليد ارسال به اين خطا مواجه ميشم ميشه بگيد مشکل از چيه !*



Adodc.RecordSet.Update.JPG

----------


## Snoopboy

> *سلام
> 
>  ببخشيد من بعد از زدن کليد ارسال به اين خطا مواجه ميشم ميشه بگيد مشکل از چيه !*
> 
> 
> 
> Adodc.RecordSet.Update.JPG


برای منم این اررور میاد . مشکل چیه؟

----------


## ali682344

ويروسيه
ميشه فايلو مجددا بدون فايل exe  بزاريد چون انتي ويروس نم زاره دان بشه

----------


## HjSoft

error که دریافت می کنید را بنویسید .

----------


## look20

دوستان برای برطرف کردن ارور کافی بعد از عبارت 
Private Sub cmdSend1_Click()
این کدو قرار بدید
on error goto errlabel
errlabel:
if err.number = -2147467259 then
end if

----------


## ehsan78mp

ویـــــــــــــــــــــــ  ـــــــــــــــــــــــــ  ـــــــــــــــــــــــــ  ـــــــــــــــــــــــــ  ــروسیه
لطفا درستش کنین

----------


## persian_bigboy

بابا دیگه پیشرفت کنید به .net رو کنید . کل این مشکلات شما دوستان حل میشه . همین دیگه انقدر هم سختی نمی کشید . یا علی

----------


## alishademan

دوستان درسته ویروسیه ولی یه دقیقه انتی ویروستون رو غیر فعال کنید بعد دوباره بعد از خارج شدن از فشرده انتی ویروس رو دوباره فعال کنید

----------


## mahboob_920

untitled.jpgسلام 
منم موقعی که می خوام اجرا کنم این ایرادو میگیره

----------


## behzad_vb.net

سلام به همگی و نویسنده این برنامه ارسال ایمیل من یک مشکل اساسی با این برنامه دارم که این نمیتونه ایمیل فارسی بفرسته راه هلش چیه :گریه:

----------


## صنعانان

دستت درد نكنة متشكرم

----------


## MohammadGh2011

سلام عليكم



> دستت درد نكنة متشكرم


براي تشكر كردن از دكمه ي تشكر استفاده كنيد و پست جديدي ايجاد نكنيد.


موفق باشيد.

----------


## alimanam

با سلام

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

'*************************************************  ***********
'3)Winsock example   
' code from: heinlein@execpc.com 
'*************************************************  ************
'you MUST put the Winsock1 control on your form



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

موفق باشید ./

----------

