|
||
| Editor Login | Register | ||
| > Bilgisayar > Nesne Programlama > visual basic |
|
|
| SMTP Sunucusu Kullanarak Mail Göndermek |
|
Bilindigi uzere gelisen teknolojiler ve kullanici istekleri dogrultusunda yazilimlarin sadece veriyi manipule etmesi yeterli olmamaktadir.Artik yazilimlarin otomatik olarak mail veya fax gondermesi bir standart haline gelmistir. Visual basic ile gelen mail ocx leri ile vb icinden mail gondermek mumkundur.Fakat bu yontem sadece kullanicinin bilgisayarinda kurulu bir mail hesabi mevcutsa mumkundur.Veya sirket politikasi olarak musterilere gonderilen standart email mesajlarinin sadece bir email adresinden gonderilmesi gerekiyorsa bu yontem yetersiz kalacaktir. Bu tur isteklere cozum getirebilmek icin yazilim firmalari urettikleri yazilimlari SMTP sunucularina entegre hale getirmektedirler. Iste asagidaki kod vb icerisinden SMTP sunucularini kullanarak mail gondermemize yarayacaktir.Ustelik attachment dahil(SMTP ile attachment gonderebilmek icin UUENCODE algoritmasi kullanilmaktadir.Daha genis bilgi icin lutfen rfclere basvurun). Asagidaki kodu bir ClassModule icerisine kopyalayin //////////////////////////////////////////////////////////////////////////////// Option Strict Off Option Explicit On Imports VB = Microsoft.VisualBasic Friend Class clsSMTPSendMail *********************************************************************** GENERAL Modul ismi : clsSMTPSendMail *********************************************************************** Aciklama : SMTP sunucusu uzerinden mail gondermek, UUEncode algoritmasi Yazan : Levent YILDIZ Sirket : Tarih : 21.08.2003 Notlar : *********************************************************************** PUBLIC SUBS *********************************************************************** AddAttachFile : Maile dosya eklemek (ByVal vFilePath As String) ClearAttachedFiles : Maile 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(ByRef StatCode As Short) 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(ByRef 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 Short Private mvarSMTPRemotePort As Integer Private WithEvents mvarWSocket As AxMSWinsockLib.AxWinsock Private mlocData As String *********************************************************************** Sub AddAttachFile(ByVal vFilePath As String) *********************************************************************** Yazan : Levent YILDIZ Sirket : Tarih : 22.08.2003 Amac : Maile 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 : Maile 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 Integer *********************************************************************** 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 .CtlState = MSWinsockLib.StateConstants.sckClosed Then strDate = VB6.Format(Today, "Ddd") & ", " & VB6.Format(Today, "dd Mmm YYYY") & " " & VB6.Format(TimeOfDay, "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 = MSWinsockLib.ProtocolConstants.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(ByRef 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 = VB.Timer() Do mlocTmr = VB.Timer() - mlocStart System.Windows.Forms.Application.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 eventSender As System.Object, ByVal eventArgs As AxMSWinsockLib.DMSWinsockControlEvents_DataArrivalEvent) Handles mvarWSocket.DataArrival mvarWSocket.GetData(mlocData) RaiseEvent SMTPServerResponse(mlocData) System.Diagnostics.Debug.WriteLine(mlocData) End Sub Function UUEncodeFile(ByRef 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 Short file handler Dim intTempFile As Short temp file Dim lFileSize As Integer size of the file Dim strFilename As String name of the file Dim strFileData As String file data chunk Dim lEncodedLines As Integer number of encoded lines Dim strTempLine As String temporary string Dim I As Integer loop counter Dim j As Short 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 FileOpen(intFile, strFilePath, OpenMode.Binary) 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 UPGRADE_WARNING: Get was upgraded to FileGet and has a new behavior. Click for more: ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1041" FileGet(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 FileClose(intFile) add the end marker strResult = strResult & "`" & vbLf & "end" & vbLf asign return value UUEncodeFile = strResult End Function *********************************************************************** Property SMTPServerName() As String Get SMTPServerName = Trim(mvarSMTPServerName) End Get Set(ByVal Value As String) mvarSMTPServerName = Trim(Value) End Set End Property *********************************************************************** Property SenderName() As String Get SenderName = Trim(mvarSenderName) End Get Set(ByVal Value As String) mvarSenderName = Trim(Value) End Set End Property *********************************************************************** Property SenderEmailAddress() As String Get SenderEmailAddress = Trim(mvarSenderEmailAddress) End Get Set(ByVal Value As String) mvarSenderEmailAddress = Trim(Value) End Set End Property *********************************************************************** Property RecipientName() As String Get RecipientName = Trim(mvarRecipientName) End Get Set(ByVal Value As String) mvarRecipientName = Trim(Value) End Set End Property *********************************************************************** Property RecipientEmailAddress() As String Get RecipientEmailAddress = Trim(mvarRecipientEmailAddress) End Get Set(ByVal Value As String) mvarRecipientEmailAddress = Trim(Value) End Set End Property *********************************************************************** Property EmailSubject() As String Get EmailSubject = Trim(mvarEmailSubject) End Get Set(ByVal Value As String) mvarEmailSubject = Trim(Value) End Set End Property *********************************************************************** Property EmailBody() As String Get EmailBody = Trim(mvarEmailBody) End Get Set(ByVal Value As String) mvarEmailBody = Trim(Value) End Set End Property *********************************************************************** Property LocData() As String Get LocData = mlocData End Get Set(ByVal Value As String) mlocData = Value End Set End Property *********************************************************************** Property SMTPTimeOut() As Short Get SMTPTimeOut = mvarSMTPTimeOut End Get Set(ByVal Value As Short) mvarSMTPTimeOut = Value End Set End Property *********************************************************************** WriteOnly Property WSocket() As AxMSWinsockLib.AxWinsock Set(ByVal Value As AxMSWinsockLib.AxWinsock) mvarWSocket = Value End Set End Property *********************************************************************** Property SMTPRemotePort() As Integer Get SMTPRemotePort = mvarSMTPRemotePort End Get Set(ByVal Value As Integer) mvarSMTPRemotePort = Value End Set End Property *********************************************************************** ReadOnly Property AttachFiles(ByVal Index As Short) As String Get If Index > UBound(mvarAttachFiles) Then Exit Property AttachFiles = mvarAttachFiles(Index) End Get End Property *********************************************************************** UPGRADE_NOTE: Class_Initialize was upgraded to Class_Initialize_Renamed. Click for more: ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1061" Private Sub Class_Initialize_Renamed() varsayilan degerler ataniyor SMTPTimeOut = 60 SMTPRemotePort = 25 ReDim mvarAttachFiles(0) End Sub Public Sub New() MyBase.New() Class_Initialize_Renamed() End Sub End Class //////////////////////////////////////////////////////////////////////////////// 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(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command1.Click Dim ClassSMTP As New clsSMTPSendMail 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 //////////////////////////////////////////////////////////////////////// Command buttona bastiginizda mailiniz gonderilecektir. |
|
| Bağlantılar: bilgininefendisi.net |
| Open Source Document Project | AUP&TOS |