Favorilerine Ekle | Giriş Sayfan Yap | Tavsiye Et

 

Kurs Tanıtım Sayfası | Süper Üye Kimdir? | Menü Tasarımı Konulu Örnek Ders
Kod İndir| Hazır Kodlar | Makaleler| İpuçları | VB .NET Kursu | Dersler | Forum | Alt Bölümler | Servisler
    Merhaba Misafir
    anasayfa » visual basic hazır kodlar » inetle mail yollamak.. (hazır Kod)
Üye Girişi
Kullanıcı Adı:  
Şifre : 
Kaydet ?
Siteden tam olarak faydalanabilmek için üye olmalısınız.
Unuttuğunuz şifrenizi öğrenebilmek için kayıt sırasında verdiğiniz Hatırlatma Cevabı'nı bilmeniz gereklidir.
Şifre hatırlatma işlevini sadece 3 defa kullanma hakkınız vardır.
Kullanıcı adını ve şifresini unutan üyelere email ile yardım verilmez.

Aktivasyon Gelmedi mi?Aktivasyon mesajınız email adresinize gelmedi mi?
Buraya tıklayarak bir kez daha aktivasyon mesajı gönderilmesini sağlayabilirsiniz.
Lütfen email hesabınızın BULK ve SPAM klasörlerini de kontrol ediniz.
Rastgele Makale

Sürücünün içi bos mu dolu mu???

Yazar: suleymangunay
Bunu Belirtir............


Webmasterlar
Sitenize Ekleyin!
Sitenizde "Son Eklenen 10 Visual Basic Yazısı"'nı göstermek ve içeriğini zenginleştirmek için buraya tıklayınız.

Vbasicmaster.com'a link verin!
Aşağıdaki minik banneri sitenize eklemek için tıklayın!

Üye Sayısı:
Ziyaretçiler nerede?
Yayın № : 8896
Yayın Tar:18.06.2007
Yazar : sdoganay
Hit :2428

Bu Yazarın Yazıları Sadece bu yazarın örnek kod göster
Bu Yazıyı Tavsiye Et

Projenize 2 Adet Form Ekleyin ve ;

1.Formumuz, SMTP server ekleyecegimiz Forum olucak...Bunun içIn forum üzerinde 2 Textbox 1 Button ekleyin...

1.textbox SMTP adresi içIn 2.textboxda SMTP Portu içIn olsun,Ve aşşagıdaki kodları formun icine yapıştırınız..

Option Explicit

Public OK As Boolean

Private Sub cmdAdd_Click()
If Len(Trim(txtServer.Text)) = 0 Then
MsgBox "Lütfen Server Bilgisini Giriniz..(Örnek:smtp.kodsayfasi.com)"
txtServer.SetFocus
Exit Sub
End If
If Len(Trim(txtPort.Text)) = 0 Or Not IsNumeric(txtPort.Text) Then
MsgBox "Hatalı Port veya Boş Port"
txtPort.SetFocus
Exit Sub
End If
OK = True
Me.Hide
End Sub

2.Formumuz Mail Gönderme ile ilgili olan Formumuz olacak..Bunun icinde

4 Text 1 Button 1 Listbox ekleyelim..

1.Text Gönderenin Maili 2.Text Alıcının Maili,3.Text Konu içIn 4.Text Mesaj içIn Listbox SMTP server listesini göstermek ve buradan server seçmek içindir.

Aşagıdaki kodları formun içerisine kopyalayınız..


Option Explicit
Private DataAvailable As Boolean
Dim inData As String
Private Timer As Long
Private change As Boolean
Private Const TIME_OUT = 30


Private Sub Check1_Click()
If Check1.Value = 1 Then
Check1.Tag = "html;"
Else
Check1.Tag = "plain;"
End If
End Sub

Private Sub cmdAdd_Click()
Dim fAdd As New Add
fAdd.Show vbModal
If fAdd.OK Then
List1.AddItem Trim(fAdd.txtServer.Text) + ":" + fAdd.txtPort.Text
change = True
End If
Unload fAdd
End Sub

Private Sub cmdRemove_Click()
If Not List1.ListIndex < 0 Then
List1.RemoveItem List1.ListIndex 'Remove item
change = True
End If
End Sub

Private Sub Form_Load()
Dim i As Integer
Dim str As String
DataAvailable = False
Timer = 0
change = False
On Error GoTo errhandler
Open "servers.txt" For Input As #1 'Open SMTP server list file
While Not EOF(1)
Line Input #1, str
List1.AddItem Trim(str)
Wend
Close #1
Exit Sub
errhandler:
MsgBox "Error opening servers.txt"
End
End Sub


Private Sub Label6_Click()
MsgBox "Programmed By Saurabh Gupta" + vbCrLf + "E-mail: saurabh_gupta@india.com" + vbCrLf + "Homepage: http://www.saurabhonline.org", vbOKOnly, "About anyMail"
End Sub

Private Sub txtSender_GotFocus()
If txtSender.Tag = 0 Then
txtSender.Tag = 1
txtSender.Text = ""
End If
End Sub
Private Sub txtSender_Validate(KeepFocus As Boolean)
If txtSender.Text = "" Then
txtSender.Text = "murat@kodsayfasi.com"
KeepFocus = False
txtSender.Tag = 0
End If
End Sub
Private Sub txtReceiver_GotFocus()
If txtReceiver.Tag = 0 Then
txtReceiver.Tag = 1
txtReceiver.Text = ""
End If
End Sub
Private Sub txtReceiver_Validate(KeepFocus As Boolean)
If txtReceiver.Text = "" Then
txtReceiver.Text = "murat@yangelyat.net"
KeepFocus = False
txtReceiver.Tag = 0
End If
End Sub

Private Sub txtSubject_GotFocus()
If txtSubject.Tag = 0 Then
txtSubject.Tag = 1
txtSubject.Text = ""
End If
End Sub
Private Sub txtSubject_Validate(KeepFocus As Boolean)
If txtSubject.Text = "" Then
txtSubject.Text = "Konuyu Giriniz . . ."
KeepFocus = False
txtSubject.Tag = 0
End If
End Sub

Private Sub txtMessage_GotFocus()
If txtMessage.Tag = 0 Then
txtMessage.Tag = 1
txtMessage.Text = ""
End If
End Sub
Private Sub txtMessage_Validate(KeepFocus As Boolean)
If txtMessage.Text = "" Then
txtMessage.Text = "Type Message Here . . ."
KeepFocus = False
txtMessage.Tag = 0
End If
End Sub

Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
If Not Number = sckSuccess Then
MsgBox Description 'Display Error
Timer1.Enabled = False
CloseConn True
End If
End Sub

Private Sub cmdSend_Click()
If List1.ListIndex < 0 Then
MsgBox "Öncelikle SMTP Server Seçiniz"
Exit Sub
End If
If txtSender.Tag = 0 Then
MsgBox "Gönderenin Mail Adresini Giriniz"
txtSender.SetFocus
Exit Sub
End If
If txtReceiver.Tag = 0 Then
MsgBox "Gönderilecek Adresi Giriniz"
txtReceiver.SetFocus
Exit Sub
End If
If txtSubject.Tag = 0 Then
MsgBox "Konuyu Giriniz"
txtSubject.SetFocus
Exit Sub
End If

Dim tmp() As String
tmp = Split(List1.List(List1.ListIndex), ":")
cmdSend.Enabled = False
cmdSend.Caption = "Baglanıyor..."
Winsock1.Connect tmp(0), Val(tmp(1))
txtSender.Enabled = False
txtReceiver.Enabled = False
txtSubject.Enabled = False
txtMessage.Enabled = False
List1.Enabled = False
End Sub

Private Sub Winsock1_DataArrival _
(ByVal bytesTotal As Long)
Dim data As String
Winsock1.GetData data, vbString
inData = inData + data
If StrComp(Right$(inData, 2), vbCrLf) = 0 Then DataAvailable = True
End Sub
Private Sub Winsock1_Connect()
cmdSend.Caption = "Connected"
Timer = 0
Timer1.Enabled = True
While Not DataAvailable
If Winsock1.State = sckClosed Then Exit Sub
DoEvents
Wend
Timer1.Enabled = False

Dim reply As String
Dim tmp() As String
reply = inData
inData = ""
DataAvailable = False
tmp = Split(reply, " ")
If Not Val(tmp(0)) = 220 Then
MsgBox "Mail Gönderilirken Serverde Hata Oluştu:" + vbCrLf + reply
CloseConn False
Exit Sub
End If
cmdSend.Caption = "Hoşgeldiniz"
'Start the process
Winsock1.SendData "Merhaba " + Winsock1.LocalHostName + vbCrLf
DoEvents
Timer = 0
Timer1.Enabled = True
While Not DataAvailable
If Winsock1.State = sckClosed Then Exit Sub
DoEvents
Wend
Timer1.Enabled = False
reply = inData
inData = ""
DataAvailable = False
tmp = Split(reply, " ")
If Not Val(tmp(0)) = 250 Then
MsgBox "Gönderim Tekrar Denendi..Hata Oluştu:" + vbCrLf + reply
CloseConn False
Exit Sub
End If
'Send MAIL FROM
Winsock1.SendData "MAIL FROM:<" + txtSender.Text + ">" + vbCrLf
DoEvents
Timer = 0
Timer1.Enabled = True
While Not DataAvailable
If Winsock1.State = sckClosed Then Exit Sub
DoEvents
Wend
Timer1.Enabled = False
reply = inData
inData = ""
DataAvailable = False
tmp = Split(reply, " ")
If Not Val(tmp(0)) = 250 Then
MsgBox "Gönderim Tekrar Denendi..Hata Oluştu:" + vbCrLf + reply
CloseConn True
Exit Sub
End If
'Send RCPT To
Winsock1.SendData "RCPT To:<" + txtReceiver.Text + ">" + vbCrLf
DoEvents
Timer = 0
Timer1.Enabled = True
While Not DataAvailable
If Winsock1.State = sckClosed Then Exit Sub
DoEvents
Wend
Timer1.Enabled = False
reply = inData
inData = ""
DataAvailable = False
tmp = Split(reply, " ")
If Not Val(tmp(0)) = 250 Then
MsgBox "Gönderim Tekrar Denendi..Hata Oluştu:" + vbCrLf + reply
CloseConn True
Exit Sub
End If
'Send DATA
DoEvents
Winsock1.SendData "DATA" + vbCrLf
DoEvents
Timer = 0
Timer1.Enabled = True
While Not DataAvailable 'Wait For reply
If Winsock1.State = sckClosed Then Exit Sub
DoEvents
Wend
Timer1.Enabled = False
reply = inData
inData = ""
DataAvailable = False
tmp = Split(reply, " ")
If Not Val(tmp(0)) = 354 Then
MsgBox "Gönderim Tekrar Denendi..Hata Oluştu:" + vbCrLf + reply
CloseConn False
Exit Sub
End If
cmdSend.Caption = "Mail Gönderiliyor...."
'Send the E-Mail
Winsock1.SendData "From: <" + txtSender.Text + ">" + vbCrLf + _
"To: " + txtReceiver.Text + vbCrLf + _
"Subject: " + txtSubject.Text + vbCrLf + _
"X-Mailer: anyMail v1.1" + vbCrLf + _
"Mime-Version: 1.0" + vbCrLf + _
"Content-Type: Text/" + Check1.Tag + vbTab + "charset=us-ascii" + vbCrLf + vbCrLf + _
txtMessage.Text
Winsock1.SendData vbCrLf + "." + vbCrLf
DoEvents
Timer = 0
Timer1.Enabled = True
While Not DataAvailable 'Wait For reply
If Winsock1.State = sckClosed Then Exit Sub
DoEvents
Wend
Timer1.Enabled = False
reply = inData
inData = ""
DataAvailable = False
tmp = Split(reply, " ")
If Not Val(tmp(0)) = 250 Then 'Error occured
MsgBox "Gönderim Tekrar Denendi..Hata Oluştu:" + vbCrLf + reply
CloseConn False
Exit Sub
End If
Winsock1.SendData "QUIT"
MsgBox "Message Sent"
CloseConn False
End Sub

Private Sub Timer1_Timer()
Timer = Timer + 1
If Timer = TIME_OUT Then
CloseConn True
MsgBox "Baglantı Saglanamadı " + List1.List(List1.ListIndex) + vbCrLf + "Operation timed out"
Timer1.Enabled = False
End If
End Sub
Private Sub CloseConn(Err As Boolean)
Winsock1.Close
cmdSend.Caption = "Gönder"
cmdSend.Enabled = True
txtSender.Enabled = True
txtReceiver.Enabled = True
txtSubject.Enabled = True
txtMessage.Enabled = True
List1.Enabled = True
If Err Then If MsgBox("Serveri Silmek İsteniginizden Eminmisiniz?", vbYesNo) = vbYes Then cmdRemove_Click
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode = vbFormControlMenu And change Then
If MsgBox("Serverdeki Liste Degiştiriliyor.Onaylıyormusunuz?", vbYesNo) = vbYes Then
Open "servers.txt" For Output As #1
Dim i As Integer
For i = 0 To List1.ListCount - 1
Print #1, List1.List(i)
Next i
Close #1
End If
End If
End Sub





Yorumlar, eklemeler ve düşünceler
        Anlatman ile kodlar arasında dunya kadar fark var. Sen sadece textbox ve butonları ekle diyorsun ama bunların isimleri farklı. Ve eklenmesi gereken timerlar,activexlar var. Yani sadece kesip atmışssın. Acemi biri için anlamsı çok zor. İncelemenizi isterim..

   hakan_183, 23.06.2007 20:17
   ya ne ineti arkadaşım bu winsockla yapılmış allala puan almak için döküman ekliorsunuz yöneticiler hiç görmüyormu acaba bu kadar rezillik olmazki

   cemilsarsilmaz, 16.07.2007 10:42
   hemde bu kod alıntı..

   sevdayorgunu90, 28.07.2007 19:43
   saol ellerine sağlık

   MoDiFiYeCiM, 02.08.2007 14:46
   bukadar kod a ne grek var anlamıyorum

   amiral, 18.11.2007 02:42
© Hakan Ersöz 2000-2013| Üyelik Sözleşmesi | | Ödeme Bildirimi
Sitemizden yenilikleri hemen öğrenin, pop upları engelleyin, chat yapın... ToolBarımızı indirin:
Vasicmaster Toolbar'ı indirin