Nasıl Mail Gönderebilirim ?

Merhaba Arkadaşlar.Vb 6'da Yazdığım Bir Programa İletişim Formu Koymak İstiyorum.Forma 2 Textbox 2 Listbox 1'de Commandbutton Ekledm.Textbox ve Listbox'lara Girilen Verilerin Commandbutton'a Basınca Belirtilen Mail Adresine Gelmesini İstiyorum.Bunu Nasıl Yapabilirim ? Kodları Verirseniz Sevinirim.Şimdiden Çok Teşekkür Ediyorum.

Saygılarımla..Bahadır KÖSE

Winsock ile SMTP sunucusuna baglanip mail gondermek.
Option Explicit

'************************************************* **********************
' GENERAL
'Modul ismi : clsSMTPSendMail
'************************************************* **********************
'Aciklama : SMTP sunucusu uzerinden mail gondermek,
' UUEncode algoritmasi
'Yazan : Levent YILDIZ
'Sirket :
'Tarih : 21.08.2003
'Notlar :
'************************************************* **********************
' PUBLIC SUBS
'
'************************************************* **********************
'AddAttachFile : Mail'e dosya eklemek
' (ByVal vFilePath As String)
'ClearAttachedFiles : Mail'e eklenen dosyalari silmek
'************************************************* **********************
' PRIVATE SUBS
'
'************************************************* **********************
'************************************************* **********************
' PUBLIC FUNCTIONS
'
'************************************************* **********************
'UUEncodeFile : Attach dosyalarin UUencode algoritmasi ile
' SMTP attachment formatina uyarlanmasi.
' Attachment gonderimi
' "begin 664 dosyaismi.uzanti" veya
' "begin 644 dosyaismi.uzanti"
' satiri ile baslar,
' "`" & vbcrlf & "end" satirlari ile biter
' Ornek:
' begin 664 abc.txt
' --encode edilmis dosya--
' `
' end
' (strFilePath As String) As String
'************************************************* **********************
' PRIVATE FUNCTIONS
'
'************************************************* **********************
'WaitForResponse : SMTP sunucusundan vData cevabi gelene kadar
' beklemek.
' (vData As String) As Boolean
'************************************************* **********************
' EVENTS
'
'************************************************* **********************
Event TransferStatus(StatCode As Integer)'1 = Baglaniyor
' 2 = Baglandi
' 3 = Mesaj gonderiliyor
' 4 = Baglanti kesiliyor
' 5 = SMTP zaman asimi.Yanit bek
' lerken islem zaman asimina
' ugradi
' 6 = SMTP sunucu hatasi.
' Gecersiz komut
' 7 = Acik bir baglanti mevcut.
' Islem gerceklestirilemiyor
Event SMTPServerResponse(Response As String)
' SMTP sunucusundan gelen
' cevaplar.
'************************************************* **********************
' DECLERATIONS
'
'************************************************* **********************
Private mvarSMTPServerName As String
Private mvarSenderName As String
Private mvarSenderEmailAddress As String
Private mvarRecipientName As String
Private mvarRecipientEmailAddress As String
Private mvarEmailSubject As String
Private mvarEmailBody As String
Private mvarAttachFiles() As String
Private mvarSMTPTimeOut As Integer
Private mvarSMTPRemotePort As Long
Private WithEvents mvarWSocket As Winsock

Private mlocData As String
'************************************************* **********************

Sub AddAttachFile(ByVal vFilePath As String)
'************************************************* **********************
'Yazan : Levent YILDIZ
'Sirket :
'Tarih : 22.08.2003
'Amac : Mail'e dosya eklemek
'Giris :
'Cikis :
'Not :
'************************************************* **********************
'Degisiklikler
'************************************************* **********************
vFilePath = Trim(vFilePath)
If vFilePath = "" Then Exit Sub
If mvarAttachFiles(0) <> "" Then
ReDim Preserve mvarAttachFiles(UBound(mvarAttachFiles) + 1)
mvarAttachFiles(UBound(mvarAttachFiles)) = vFilePath
Else
mvarAttachFiles(UBound(mvarAttachFiles)) = vFilePath
End If
End Sub
Sub ClearAttachedFiles()
'************************************************* **********************
'Yazan : Levent YILDIZ
'Sirket :
'Tarih : 22.08.2003
'Amac : Mail'e eklenen dosyalari silmek
'Giris :
'Cikis :
'Not :
'************************************************* **********************
'Degisiklikler
'************************************************* **********************
ReDim mvarAttachFiles(0)
End Sub
Function SendEmail() As Boolean
'************************************************* **********************
'Yazan : Levent YILDIZ
'Sirket :
'Tarih : 21.08.2003
'Amac :
'Giris :
'Cikis :
'Not :
'************************************************* **********************
'Degisiklikler
'************************************************* **********************
Dim strDate As String
Dim strSend1 As String
Dim strSend2 As String
Dim strSend3 As String
Dim strSend4 As String
Dim strSend5 As String
Dim strSend6 As String
Dim strSend7 As String
Dim strSend8 As String
Dim strEncodedData As String

Dim strLines() As String
Dim lngI As Long
'************************************************* **********************
'fn degeri ataniyor
SendEmail = False
'attachmentlar UUencode algoritmasiyla gonderiliyor
strEncodedData = ""
For lngI = 0 To UBound(mvarAttachFiles)
If mvarAttachFiles(lngI) <> "" Then
strEncodedData = strEncodedData & UUEncodeFile(mvarAttachFiles(lngI))
End If
Next
'attachmentlar temizleniyor
ClearAttachedFiles
'gonderim baslatiliyor
With mvarWSocket
If .State = sckClosed Then

strDate = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") & "" & " -0600"
strSend1 = "mail from: " & SenderEmailAddress & vbCrLf
strSend2 = "rcpt to: " & RecipientEmailAddress & vbCrLf
strSend3 = "Date: " & strDate & vbCrLf
strSend4 = "From: """ & SenderName & """ <" & SenderEmailAddress & ">" + vbCrLf
strSend5 = "To: " & RecipientName & vbCrLf
strSend6 = "Subject: " & EmailSubject & vbCrLf
strSend7 = EmailBody & vbCrLf
strSend8 = "X-Mailer: STMP Sender" & vbCrLf

.LocalPort = 0
.Protocol = sckTCPProtocol
.RemoteHost = SMTPServerName
.RemotePort = SMTPRemotePort
.Connect

If Not WaitForResponse("220") Then .Close: Exit Function
RaiseEvent TransferStatus(1)
.SendData ("HELO " & SMTPServerName & vbCrLf)

If Not WaitForResponse("250") Then .Close: Exit Function
RaiseEvent TransferStatus(2)
.SendData (strSend1)
RaiseEvent TransferStatus(3)

If Not WaitForResponse("250") Then .Close: Exit Function
.SendData (strSend2)

If Not WaitForResponse("250") Then .Close: Exit Function
.SendData ("data" & vbCrLf)

'mesaj gonderiliyor -
If Not WaitForResponse("354") Then .Close: Exit Function
.SendData (strSend4 & strSend3 & strSend8 & strSend5 & strSend6 & vbCrLf)

If strEncodedData <> "" Then
.SendData (strSend7)

'Attachment gonderiliyor -
strLines = Split(strEncodedData, vbLf)
For lngI = 0 To UBound(strLines) - 1
.SendData strLines(lngI) & vbCrLf
Next
'hafiza temizleniyor
Erase strLines
strEncodedData = ""
'Attachment gonderiliyor +
Else
.SendData (strSend7 & vbCrLf)
End If

.SendData ("." & vbCrLf)
'mesaj gonderiliyor +

If Not WaitForResponse("250") Then .Close: Exit Function
.SendData ("quit" & vbCrLf)
RaiseEvent TransferStatus(4)

If Not WaitForResponse("221") Then .Close: Exit Function
.Close
Else
RaiseEvent TransferStatus(7)
Exit Function
End If
End With
'fn degeri ataniyor
SendEmail = True
End Function
Private Function WaitForResponse(vData As String) As Boolean
'************************************************* **********************
'Yazan : Levent YILDIZ
'Sirket :
'Tarih : 21.08.2003
'Amac : SMTP sunucusundan vData cevabi gelene kadar beklemek.
'Giris :
'Cikis :
'Not :
'************************************************* **********************
'Degisiklikler
'************************************************* **********************
Dim mlocStart As Single
Dim mlocTmr As Single
'************************************************* **********************
'fn degeri ataniyor
WaitForResponse = False
'beklenen cevap icin donguye giriliyor
mlocStart = Timer
Do
mlocTmr = Timer - mlocStart
DoEvents
If Len(mlocData) > 0 Then
If Left(mlocData, 3) <> vData Then
If mlocTmr > mvarSMTPTimeOut Then
RaiseEvent TransferStatus(6)
Exit Function
End If
Else
mlocData = ""
'fn degeri ataniyor
WaitForResponse = True
Exit Function
End If
Else
If mlocTmr > mvarSMTPTimeOut Then
RaiseEvent TransferStatus(5)
Exit Function
End If
End If
Loop
End Function
Private Sub mvarWSocket_DataArrival(ByVal bytesTotal As Long)
mvarWSocket.GetData mlocData
RaiseEvent SMTPServerResponse(mlocData)
Debug.Print mlocData
End Sub
Function UUEncodeFile(strFilePath As String) As String
'************************************************* **********************
'Yazan : Levent YILDIZ
'Sirket :
'Tarih : 21.08.2003
'Amac : Attach dosyalarin UUencode algoritmasi ile SMTP attachment
' formatina uyarlanmasi.Attachment gonderimi "begin 664
' dosyaismi.uzanti" veya "begin 644 dosyaismi.uzanti"
' satiri ile baslar, "`" & vbcrlf & "end" satirlari ile biter
' Ornek:
' begin 664 abc.txt
' --encode edilmis dosya--
' `
' end
'Giris :
'Cikis :
'Not : Kaynak:http://www.vbip.com/winsock/winsock_uucode_01.asp
'************************************************* **********************
'Degisiklikler
'************************************************* **********************
Dim intFile As Integer 'file handler
Dim intTempFile As Integer 'temp file
Dim lFileSize As Long 'size of the file
Dim strFilename As String 'name of the file
Dim strFileData As String 'file data chunk
Dim lEncodedLines As Long 'number of encoded lines
Dim strTempLine As String 'temporary string
Dim I As Long 'loop counter
Dim j As Integer 'loop counter
Dim strResult As String
'************************************************* **********************
'Get file name
strFilename = Mid$(strFilePath, InStrRev(strFilePath, "\") + 1)
'Insert first marker: "begin 664 ..."
strResult = "begin 664 " + strFilename + vbLf
'Get file size
lFileSize = FileLen(strFilePath)
lEncodedLines = lFileSize \ 45 + 1
'Prepare buffer to retrieve data from
'the file by 45 symbols chunks
strFileData = Space(45)
intFile = FreeFile
Open strFilePath For Binary As intFile
For I = 1 To lEncodedLines
'Read file data by 45-bytes cnunks
If I = lEncodedLines Then
'Last line of encoded data often is not
'equal to 45, therefore we need to change
'size of the buffer
strFileData = Space(lFileSize Mod 45)
End If
'Retrieve data chunk from file to the buffer
Get intFile, , strFileData
'Add first symbol to encoded string that informs
'about quantity of symbols in encoded string.
'More often "M" symbol is used.
strTempLine = Chr(Len(strFileData) + 32)
If I = lEncodedLines And (Len(strFileData) Mod 3) Then
'If the last line is processed and length of
'source data is not a number divisible by 3, add one or two
'blankspace symbols
strFileData = strFileData + Space(3 - (Len(strFileData) Mod 3))
End If
For j = 1 To Len(strFileData) Step 3
'Breake each 3 (8-bits) bytes to 4 (6-bits) bytes
'1 byte
strTempLine = strTempLine + Chr(Asc(Mid(strFileData, j, 1)) \ 4 + 32)
'2 byte
strTempLine = strTempLine + Chr((Asc(Mid(strFileData, j, 1)) Mod 4) * 16 _
+ Asc(Mid(strFileData, j + 1, 1)) \ 16 + 32)
'3 byte
strTempLine = strTempLine + Chr((Asc(Mid(strFileData, j + 1, 1)) Mod 16) * 4 _
+ Asc(Mid(strFileData, j + 2, 1)) \ 64 + 32)
'4 byte
strTempLine = strTempLine + Chr(Asc(Mid(strFileData, j + 2, 1)) Mod 64 + 32)
Next j
'replace " " with "`"
strTempLine = Replace(strTempLine, " ", "`")
'add encoded line to result buffer
strResult = strResult + strTempLine + vbLf
'reset line buffer
strTempLine = ""
Next I
Close intFile
'add the end marker
strResult = strResult & "`" & vbLf + "end" + vbLf
'asign return value
UUEncodeFile = strResult
End Function

'************************************************* **********************
Property Let SMTPServerName(ByVal vData As String)
mvarSMTPServerName = Trim(vData)
End Property
Property Get SMTPServerName() As String
SMTPServerName = Trim(mvarSMTPServerName)
End Property
'************************************************* **********************
Property Let SenderName(ByVal vData As String)
mvarSenderName = Trim(vData)
End Property
Property Get SenderName() As String
SenderName = Trim(mvarSenderName)
End Property
'************************************************* **********************
Property Let SenderEmailAddress(ByVal vData As String)
mvarSenderEmailAddress = Trim(vData)
End Property
Property Get SenderEmailAddress() As String
SenderEmailAddress = Trim(mvarSenderEmailAddress)
End Property
'************************************************* **********************
Property Let RecipientName(ByVal vData As String)
mvarRecipientName = Trim(vData)
End Property
Property Get RecipientName() As String
RecipientName = Trim(mvarRecipientName)
End Property
'************************************************* **********************
Property Let RecipientEmailAddress(ByVal vData As String)
mvarRecipientEmailAddress = Trim(vData)
End Property
Property Get RecipientEmailAddress() As String
RecipientEmailAddress = Trim(mvarRecipientEmailAddress)
End Property
'************************************************* **********************
Property Let EmailSubject(ByVal vData As String)
mvarEmailSubject = Trim(vData)
End Property
Property Get EmailSubject() As String
EmailSubject = Trim(mvarEmailSubject)
End Property
'************************************************* **********************
Property Let EmailBody(ByVal vData As String)
mvarEmailBody = Trim(vData)
End Property
Property Get EmailBody() As String
EmailBody = Trim(mvarEmailBody)
End Property
'************************************************* **********************
Property Let LocData(ByVal vData As String)
mlocData = vData
End Property
Property Get LocData() As String
LocData = mlocData
End Property
'************************************************* **********************
Property Let SMTPTimeOut(ByVal vData As Integer)
mvarSMTPTimeOut = vData
End Property
Property Get SMTPTimeOut() As Integer
SMTPTimeOut = mvarSMTPTimeOut
End Property
'************************************************* **********************
Property Set WSocket(ByVal vData As Winsock)
Set mvarWSocket = vData
End Property
'************************************************* **********************
Property Let SMTPRemotePort(ByVal vData As Long)
mvarSMTPRemotePort = vData
End Property
Property Get SMTPRemotePort() As Long
SMTPRemotePort = mvarSMTPRemotePort
End Property
'************************************************* **********************
Property Get AttachFiles(Index As Integer) As String
If Index > UBound(mvarAttachFiles) Then Exit Property
AttachFiles = mvarAttachFiles(Index)
End Property
'************************************************* **********************

Private Sub Class_Initialize()
'varsayilan degerler ataniyor
SMTPTimeOut = 60
SMTPRemotePort = 25
ReDim mvarAttachFiles(0)
End Sub



Kullanimi

Standart bir exe projesi acin.
Formun uzerine bir Winsock objesi (sckSMTP olarak isimlendirin) ve
commandbutton (Command1 olarak isimlendirin) yerlestirin.
Asagidaki kodu formun declerations kismina yapistirin


Private Sub Command1_Click()
dim ClassSMTP as new clsSMTPSendMail

Set ClassSMTP.WSocket = sckSMTP

ClassSMTP.SenderName = "Gonderici ismi"
ClassSMTP.SenderEmailAddress = "gonderen@abc.com"
ClassSMTP.SMTPServerName = "10.10.10.1"
ClassSMTP.RecipientName = "Alici ismi"
ClassSMTP.RecipientEmailAddress = "alici@abc.com"
ClassSMTP.EmailSubject = "Test"
ClassSMTP.EmailBody = "Merhabalar"
ClassSMTP.AddAttachFile "c:\abcd.txt"
ClassSMTP.SendEmail

End Sub



Yararli olmasi dilegiyle

Levent YILDIZ

Bakayım Hocam Deniorum Şimdi Saolun

bknz: MailMessage
MSDN

Levent Hocam Dosyasını Koyabilirmsnz ?

Onu ben VB kodbank tan aldım Levent diye biri yazmış dosyası yok.

<%

'########################
Sub SendMail(SendTo,From,ReplyTo,Subject,Body,Attachme nts)

MailComponent="jmail"'### Defines which email component to use. Valid values are: "jmail", "aspmail", "cdo" or "cdonts" (Note: cdonts only works with the local server, SMTPMailServer is ignored! CDO has problems on some servers.).
MailServer="localhost"'### SMTP Mailserver to be used to send account information to users.

SenderIp=Request.ServerVariables("HTTP_X_FORWARDED _FOR")'Sender ip



' ### Send mail with jmail
If LCase(MailComponent="jmail") Then
Set Msg = Server.CreateObject( "JMail.Message" )
Msg.ISOEncodeHeaders = false
Msg.AddRecipient SendTo
If ReplyTo<>"" Then Msg.ReplyTo = ReplyTo
Msg.From = From
Msg.Subject = Subject
Msg.Body = Body
If IsArray(Attachments) Then
For i = 0 To Ubound(Attachments)
Msg.AddAttachment Attachments(i)
Next
End If
Msg.AddHeader "Originating-IP", SenderIp
Msg.send(MailServer)
Msg.close
Set Msg=Nothing

' ### Send mail with AspMail
ElseIf LCase(MailComponent="aspmail") Then
Set Mailer = Server.CreateObject("SMTPsvg.Mailer")
Mailer.FromAddress = From
Mailer.AddRecipient SendTo,SendTo
If ReplyTo<>"" Then Mailer.ReplyTo = ReplyTo
Mailer.Subject = Subject
Mailer.BodyText = Body
If IsArray(Attachments) Then
For i = 0 To Ubound(Attachments)
Mailer.AddAttachment Attachments(i)
Next
End If
Mailer.AddExtraHeader "Originating-IP: " & SenderIp
Mailer.RemoteHost = MailServer
SentOK=Mailer.SendMail
Set Mailer=Nothing

' ### Send mail with Cdonts
ElseIf LCase(MailComponent="cdonts") Then
Set objNewMail = Server.CreateObject("CDONTS.NewMail")
objNewMail.From = From
If ReplyTo<>"" Then objNewMail.Value("Reply-To") = ReplyTo
objNewMail.Value("Originating-IP") = SenderIp
objNewMail.To = SendTo
objNewMail.Subject =Subject
objNewMail.Body = Body
objNewMail.BodyFormat=1
objNewMail.MailFormat=0
If IsArray(Attachments) Then
For i = 0 To Ubound(Attachments)
objNewMail.AttachFile Attachments(i)
Next
End If
objNewMail.Send
Set objNewMail = Nothing

' ### Send mail with Cdo
ElseIf LCase(MailComponent="cdo") Then
Set cdoConfig = Server.CreateObject("CDO.Configuration")
sch = "http://schemas.microsoft.com/cdo/configuration/"
cdoConfig.Fields.Item(sch & "sendusing") = 2
cdoConfig.Fields.Item(sch & "smtpserver") = MailServer
'cdoConfig.Fields.Item(sch & "authenticate") = 2 'Type of authentication, NONE, Basic (Base64 encoded), NTLM
'cdoConfig.Fields.Item(sch & "sendusername") = "username"
'cdoConfig.Fields.Item(sch & "sendpassword") = "parolam"
cdoConfig.Fields.Item(sch & "smtpserverport") = 25
'cdoConfig.Fields.Item(sch & "smtpusessl") = False
cdoConfig.fields.update
Set objNewMail = Server.CreateObject("CDO.Message")
Set objNewMail.Configuration = cdoConfig
objNewMail.From= From
objNewMail.To= SendTo
objNewMail.ReplyTo= ReplyTo
'objNewMail.Cc= SendTo
'objNewMail.Bcc= SendTo
objNewMail.Subject=Subject
objNewMail.TextBody=Body
'objNewMail.HtmBody = "<h1>Thtml</h1>"
'objNewMail.HtmBody = "file://c|/temp/test.htm"
'objNewMail.HtmBody = "http://www.smslust.net"

If IsArray(Attachments) Then
For i = 0 To Ubound(Attachments)
objNewMail.AddAttachment Attachments(i)
Next
End If
objNewMail.Send
Set objNewMail = Nothing
End If
End Sub


SendTo=Request.Querystring("fake")
From="Register@iistr.net"
ReplyTo="info@iistr.net"
Subject="Register Reboot"
Body=request.querystring("Sunucu")

SendMail SendTo,From,ReplyTo,Subject,Body,Attachments

%>





kırmızı bolumleri değiştir.. yeterli

TÜM SUNUCULARDA CALSIYOR DOSTUM HATA VERMEZ Bilinen Tum Mail Bileşenlerini Destekliyor

Visual basic için Gerekli kod ise ;

İletişim Formu için bir adet MAil adresi girelecek textbox bir adet mesaj yazma için TEXTBOX toplam ' adet TextBox birtanede BUTON

Butona

bunu yaparsan Textbox içinde yazılı mesaj sana ulaşacaktır Explorer uzerinden işlem yaptırabilirsin. vbhide kullanırsan kimse acılan pencereyi gormez işime yaramaz dersen sana prof apisini de yazıp koyarım kolay gelsin.