İnetle Mail Gönderme || VB

Formunuza 2 adet form ekleyin..

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