none
Comment faire envoyer un mail quand une application provoque une exeption? RRS feed

  • Question

  • Bonjour

    J'ai développé une application que je vais distribuer à un cercle restreint d'utilisateurs.

    Je cherche une procédure qui déclenche l'envoi d'un mail qui me soit envoyé avec les données de l'exception.

    J'ai trouvé quelques procédures pour envoyer des mails mais toujours avec un serveur SMTP défini.

    Comment faire cet envoi alors que le serveur de l'utilisateur n'est pas défini dans le code?

    Comment faire pour trouver ce serveur ? et qui du mot de passe?

    Merci pour votre aide.

    Bernard


    Bernard Bouree

    jeudi 23 juin 2016 19:12

Toutes les réponses

  • Bonjour 

    Merci je vais essayé avec le premier exemple.

    Le second me donne une erreur car Telnet n'est pas reconnu.

    Bernard


    Bernard Bouree

    vendredi 24 juin 2016 11:23
  • Bonjour

    J'ai essayé avec le premier exemple mais il ne marche pas et comme je n'y connais rien en email je n'ai pas trouvé le problème.

    Bernard


    Bernard Bouree

    dimanche 26 juin 2016 11:24
  • Bonjour

    J'ai trouvé un article qui traite de ce sujet à http://www.nullskull.com/articles/20030316.asp

    J'ai traduit le programme en VB que je connais mieux  et que voici

    Imports System.Text
    Imports System.IO
    Imports System.Net.Sockets
    Imports System.Net
    Imports System.Net.Mail
     
    'Namespace SMTP
    ''' <summary>
    ''' provides methods to send email via smtp direct to mail server
    ''' </summary>
    Public Class SmtpDirect
        ''' <summary>
        ''' Get / Set the name of the SMTP mail server
        ''' </summary>
        Public Shared SmtpServer As String= "imap.1and1.fr"
        Private Enum SMTPResponse As Integer
            CONNECT_SUCCESS = 220
            GENERIC_SUCCESS = 250
            DATA_SUCCESS = 354
            QUIT_SUCCESS = 221
        End Enum
     
        Public Shared Function Send(message As MailMessage) As Boolean
            'Dim IPhst As IPHostEntry = Dns.Resolve(SmtpServer)
            Dim IPhst As IPHostEntry = Dns.GetHostEntry(SmtpServer)
            Dim endPt As New IPEndPoint(IPhst.AddressList(0), 993)
            Dim s As New Socket(endPt.AddressFamily, SocketType.Stream, ProtocolType.Tcp)
            s.Connect(endPt)
     
            If Not Check_Response(s, SMTPResponse.CONNECT_SUCCESS) Then
                s.Close()
                Return False
            End If
     
            Senddata(s, String.Format("HELO {0}" & vbCr & vbLf, Dns.GetHostName()))
            If Not Check_Response(s, SMTPResponse.GENERIC_SUCCESS) Then
                s.Close()
                Return False
            End If
     
            Senddata(s, String.Format("MAIL From: {0}" & vbCr & vbLf, message.From))
            If Not Check_Response(s, SMTPResponse.GENERIC_SUCCESS) Then
     
                s.Close()
                Return False
            End If
     
            Dim _To As String = message.To.ToString
            Dim Tos As String() = _To.Split(New Char() {";"c})
            For Each [To] As String In Tos
                Senddata(s, String.Format("RCPT TO: {0}" & vbCr & vbLf, [To]))
                If Not Check_Response(s, SMTPResponse.GENERIC_SUCCESS) Then
                    s.Close()
                    Return False
                End If
            Next
     
            If message.CC IsNot Nothing Then
                Tos = message.CC.ToString.Split(New Char() {";"c})
                For Each [To] As String In Tos
                    Senddata(s, String.Format("RCPT TO: {0}" & vbCr & vbLf, [To]))
                    If Not Check_Response(s, SMTPResponse.GENERIC_SUCCESS) Then
                        s.Close()
                        Return False
                    End If
                Next
            End If
     
            Dim Header As New StringBuilder()
            Header.Append("From: ").Append(message.From).Append(vbCr & vbLf)
            Tos = message.To.ToString.Split(New Char() {";"c})
            Header.Append("To: ")
            For i As Integer = 0 To Tos.Length - 1
                Header.Append(If(i > 0, ",", ""))
                Header.Append(Tos(i))
            Next
            Header.Append(vbCr & vbLf)
            If message.CC IsNot Nothing Then
                Tos = message.CC.ToString.Split(New Char() {";"c})
                Header.Append("Cc: ")
                For i As Integer = 0 To Tos.Length - 1
                    Header.Append(If(i > 0, ",", ""))
                    Header.Append(Tos(i))
                Next
                Header.Append(vbCr & vbLf)
            End If
            Header.Append("Date: ")
            Header.Append(DateTime.Now.ToString("ddd, d M y H:m:s z"))
            Header.Append(vbCr & vbLf)
            Header.Append("Subject: " + message.Subject + vbCr & vbLf)
            Header.Append("X-Mailer: SMTPDirect v1" & vbCr & vbLf)
            Dim MsgBody As String = message.Body
            If Not MsgBody.EndsWith(vbCr & vbLf) Then
                MsgBody += vbCr & vbLf
            End If
            If message.Attachments.Count > 0 Then
                Header.Append("MIME-Version: 1.0" & vbCr & vbLf)
                Header.Append("Content-Type: multipart/mixed; boundary=unique-boundary-1" & vbCr & vbLf)
                Header.Append(vbCr & vbLf)
                Header.Append("This is a multi-part message in MIME format." & vbCr & vbLf)
                Dim sb As New StringBuilder()
                sb.Append("--unique-boundary-1" & vbCr & vbLf)
                sb.Append("Content-Type: text/plain" & vbCr & vbLf)
                sb.Append("Content-Transfer-Encoding: 7Bit" & vbCr & vbLf)
                sb.Append(vbCr & vbLf)
                sb.Append(MsgBody & Convert.ToString(vbCr & vbLf))
                sb.Append(vbCr & vbLf)
     
                For Each att As Attachment In message.Attachments
                    'Dim a As Attachment = TryCast(o, Attachment)
                    Dim binaryData As Byte()
                    If att IsNot Nothing Then
                        Dim f As New FileInfo(att.ContentDisposition.FileName)
                        sb.Append("--unique-boundary-1" & vbCr & vbLf)
                        sb.Append("Content-Type: application/octet-stream; file=" + f.Name + vbCr & vbLf)
                        sb.Append("Content-Transfer-Encoding: base64" & vbCr & vbLf)
                        sb.Append("Content-Disposition: attachment; filename=" + f.Name + vbCr & vbLf)
                        sb.Append(vbCr & vbLf)
                        Dim fs As FileStream = f.OpenRead()
                        binaryData = New [Byte](CInt(fs.Length - 1)) {}
                        Dim bytesRead As Long = fs.Read(binaryData, 0, CInt(fs.Length))
                        fs.Close()
                        Dim base64String As String = System.Convert.ToBase64String(binaryData, 0, binaryData.Length)
     
                        Dim i As Integer = 0
                        While i < base64String.Length
                            Dim nextchunk As Integer = 100
                            If base64String.Length - (i + nextchunk) < 0 Then
                                nextchunk = base64String.Length - i
                            End If
                            sb.Append(base64String.Substring(i, nextchunk))
                            sb.Append(vbCr & vbLf)
                            i += nextchunk
                        End While
                        sb.Append(vbCr & vbLf)
                    End If
                Next
                MsgBody = sb.ToString()
            End If
     
            Senddata(s, ("DATA" & vbCr & vbLf))
            If Not Check_Response(s, SMTPResponse.DATA_SUCCESS) Then
                s.Close()
                Return False
            End If
            Header.Append(vbCr & vbLf)
            Header.Append(MsgBody)
            Header.Append("." & vbCr & vbLf)
            Header.Append(vbCr & vbLf)
            Header.Append(vbCr & vbLf)
            Senddata(s, Header.ToString())
            If Not Check_Response(s, SMTPResponse.GENERIC_SUCCESS) Then
                s.Close()
                Return False
            End If
     
            Senddata(s, "QUIT" & vbCr & vbLf)
            Check_Response(s, SMTPResponse.QUIT_SUCCESS)
            s.Close()
            Return True
        End Function
        Public Function Send(from As String, oTo As String, subject As String, text As String) As Boolean
            Dim message As New MailMessage(from, oTo, subject, text)
            Return Send(message)
     
        End Function
        Private Shared Function Check_Response(s As Socket, response_expected As SMTPResponse) As Boolean
            Dim sResponse As String
            Dim response As Integer
            Dim bytes As Byte() = New Byte(1023) {}
            While s.Available = 0
                Threading.Thread.Sleep(100)
            End While
     
            s.Receive(bytes, 0, s.Available, SocketFlags.None)
            sResponse = Encoding.ASCII.GetString(bytes)
            response = Convert.ToInt32(sResponse.Substring(0, 3))
            If response <> CInt(response_expected) Then
                Return False
            End If
            Return True
        End Function
        Private Shared Sub Senddata(s As Socket, msg As String)
            Dim _msg As Byte() = Encoding.ASCII.GetBytes(msg)
            s.Send(_msg, 0, _msg.Length, SocketFlags.None)
        End Sub
    End Class
    'End Namespace

    Je n'arrive pas à le faire tourner correctement.

    Je bute sur la procédure  Check_Response

    avec les lignes 

    While s.Available = 0
                Threading.Thread.Sleep(100)
            End While

    qui est une boucle sans fin.

    s.Available reste toujours à 0 

    J'en conclu que le socket ne reçoit aucune information.

    la ligne  : s.Connect(endPt)

    de la procédure Send fonctionne car s.Connected = True.

    Comment détecter ce qui se passe ?

    Merci pour votre aide.

    Bernard


    Bernard Bouree

    lundi 27 juin 2016 17:07