Envoi mail vb 2005 api windows

Commenter

Contenu du snippet

Cette Classe permet L'envoi d'e-mail quelque soit votre client de messagerie par défaut elle utilise MAPI. Elle est la modification d'une classe déjà sur code Source end VB6.
Fonctionne avec Vista.

Source / Exemple : 


Imports System.Runtime.InteropServices

Public Class MailingClass

    Public Enum Mail_Software
        DefaultMailSoftware
        Smtp
    End Enum

    Private Function Isnull(ByVal Source As Object, ByVal ReplaceBy As Object) As Object
        If Source Is System.DBNull.Value Then
            Return ReplaceBy
        Else
            If Source Is Nothing Then
                Return ReplaceBy
            Else
                Return Source
            End If
        End If
    End Function

    '----------------------------------------------------------------------------------------------------------'
    '               déclaration des types utilisés
    '----------------------------------------------------------------------------------------------------------'
    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> _
      Structure Message
        Dim Reserved As Integer
        Dim Subject As String
        Dim NoteText As String
        Dim MessageType As String
        Dim DateReceived As String
        Dim ConversationID As String
        Dim flags As Integer
        Dim RecipCount As Integer
        Dim FileCount As Integer
    End Structure

    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> _
      Structure Recip
        Public Reserved As Integer
        Public RecipClass As Integer
        <MarshalAs(UnmanagedType.LPTStr)> Public Name As String
        <MarshalAs(UnmanagedType.LPTStr)> Public Address As String
        Public EIDSize As Integer
        <MarshalAs(UnmanagedType.LPTStr)> Public EntryID As String
    End Structure

    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> _
      Structure File
        Public Reserved As Integer
        Public flags As Integer
        Public POSITION As Integer
        <MarshalAs(UnmanagedType.LPTStr)> Public PathName As String
        <MarshalAs(UnmanagedType.LPTStr)> Public FileName As String
        <MarshalAs(UnmanagedType.LPTStr)> Public FileType As String
    End Structure

    Private zlParentHwnd, zlSessionID, zlShowDialogs As Integer
    Private Const MAPI_DIALOG As Short = &H8S
    Private Const MAPI_LOGON_UI As Short = &H1S
    Private Const MAPI_TO As Short = 1
    Private Const MAPI_CC As Short = 2
    Private Const MAPI_CCO As Short = 3

    Private Declare Function GetActiveWindow Lib "user32" () As Integer

    Private Declare Function MAPILogon Lib "MAPI32.DLL" (ByVal lUIParam As Integer, ByVal user As String, ByVal Password As String, ByVal lFlags As Integer, ByVal lReserved As Integer, ByRef lSession As Integer) As Integer

    Private Declare Function MAPILogoff Lib "MAPI32.DLL" (ByVal lSession As Integer, ByVal lUIParam As Integer, ByVal lFlags As Integer, ByVal lReserved As Integer) As Integer

    Private Declare Function MAPISendMailOE Lib "C:\Program Files\Outlook Express\msoe.dll" Alias "BMAPISendMail" (ByVal session As Integer, ByVal UIParam As Integer, <MarshalAs(UnmanagedType.Struct)> ByRef Message As Message, <MarshalAs(UnmanagedType.SafeArray)> ByRef Recipient() As Recip, <MarshalAs(UnmanagedType.SafeArray)> ByRef File() As File, ByVal flags As Integer, ByVal Reserved As Integer) As Integer

    Private Declare Function MAPISendMailWM Lib "C:\Program Files\Windows Mail\msoe.dll" Alias "BMAPISendMail" (ByVal session As Integer, ByVal UIParam As Integer, <MarshalAs(UnmanagedType.Struct)> ByRef Message As Message, <MarshalAs(UnmanagedType.SafeArray)> ByRef Recipient() As Recip, <MarshalAs(UnmanagedType.SafeArray)> ByRef File() As File, ByVal flags As Integer, ByVal Reserved As Integer) As Integer
    'Private Declare Function MAPISendMailWM Lib "C:\msoe.dll" Alias "BMAPISendMail" (ByVal session As Integer, ByVal UIParam As Integer, <MarshalAs(UnmanagedType.Struct)> ByRef Message As Message, <MarshalAs(UnmanagedType.SafeArray)> ByRef Recipient() As Recip, <MarshalAs(UnmanagedType.SafeArray)> ByRef File() As File, ByVal flags As Integer, ByVal Reserved As Integer) As Integer

    Private Declare Function MAPISendMail Lib "MAPI32.DLL" Alias "BMAPISendMail" (ByVal session As Integer, ByVal UIParam As Integer, <MarshalAs(UnmanagedType.Struct)> ByRef Message As Message, <MarshalAs(UnmanagedType.SafeArray)> ByRef Recipient() As Recip, <MarshalAs(UnmanagedType.SafeArray)> ByRef File() As File, ByVal flags As Integer, ByVal Reserved As Integer) As Integer

    Private Declare Function MAPILogon12 Lib "C:\Program Files\Microsoft Office\Office12\OLMAPI32.DLL" (ByVal lUIParam As Integer, ByVal user As String, ByVal Password As String, ByVal lFlags As Integer, ByVal lReserved As Integer, ByRef lSession As Integer) As Integer

    Private Declare Function MAPILogoff12 Lib "C:\Program Files\Microsoft Office\Office12\OLMAPI32.DLL" (ByVal lSession As Integer, ByVal lUIParam As Integer, ByVal lFlags As Integer, ByVal lReserved As Integer) As Integer

    Private Declare Function MAPISendMailO12 Lib "C:\Program Files\Microsoft Office\Office12\OLMAPI32.DLL" Alias "BMAPISendMail" (ByVal session As Integer, ByVal UIParam As Integer, <MarshalAs(UnmanagedType.Struct)> ByRef Message As Message, <MarshalAs(UnmanagedType.SafeArray)> ByRef Recipient() As Recip, <MarshalAs(UnmanagedType.SafeArray)> ByRef File() As File, ByVal flags As Integer, ByVal Reserved As Integer) As Integer

    Public Function SendMail(ByVal MailTo As String, ByVal Subject As String, Optional ByVal Body As String = Nothing, Optional ByVal Attachments() As String = Nothing, Optional ByVal MailFrom As String = Nothing, Optional ByVal Host As String = Nothing, Optional ByVal DirectSend As Boolean = False, Optional ByVal CC As String = Nothing, Optional ByVal CCO As String = Nothing, Optional ByVal MailingMethod As Mail_Software = Mail_Software.DefaultMailSoftware) As Boolean

        'Controle de l'adresse
        If MailTo = Nothing Then
            Throw New Exception("Adresse destinataire non définie")
            Return False
        End If

        If MailTo.LastIndexOf("@") = -1 Or MailTo.LastIndexOf(".") = -1 Then
            Throw New Exception("Adresse Destinataire Mal orthographiée")
            Return False
        End If

        Dim DefaultSoft As String = Microsoft.Win32.Registry.LocalMachine.OpenSubKey("SOFTWARE\Clients\Mail\", False).GetValue("")

        If MailingMethod = Mail_Software.Smtp Then DefaultSoft = "Smtp"

        Dim X As Integer
        Dim MAPI_Message As Message = Nothing
        Dim Nto As Integer = CountWords(MailTo, ";")
        Dim NCC As Integer = CountWords(CC, ";")
        Dim NCCO As Integer = CountWords(CCO, ";")
        Dim MAPI_recip(Nto + NCC + NCCO - 1) As Recip
        Dim MAPI_file(Attachments.Length - 1) As File
        Dim Dialog As Integer = 1

        Select Case DefaultSoft
            Case "Outlook Express", "Microsoft Outlook", "Microsoft Office Outlook", "Outlook", "Windows Mail"
                If Not DirectSend Then Dialog = 9
                MAPI_Message.Subject = Subject
                MAPI_Message.NoteText = Isnull(Body, "")

                MAPI_Message.RecipCount = MAPI_recip.Length

                For X = 0 To Nto - 1
                    MAPI_recip(X).Name = Isnull(MailTo, "").Split(";")(X)
                    MAPI_recip(X).RecipClass = MAPI_TO
                Next

                For X = 0 To NCC - 1
                    MAPI_recip(Nto + X).Name = Isnull(CC, "").Split(";")(X)
                    MAPI_recip(Nto + X).RecipClass = MAPI_CC
                Next

                For X = 0 To NCCO - 1
                    MAPI_recip(Nto + NCC + X).Name = Isnull(CC, "").Split(";")(X)
                    MAPI_recip(Nto + NCC + X).RecipClass = MAPI_CCO
                Next

                MAPI_Message.FileCount = MAPI_file.Length
                For X = 0 To Attachments.Length - 1
                    MAPI_file(X).POSITION = -1
                    MAPI_file(X).PathName = Attachments(X)
                Next
            Case Else
                DefaultSoft = "Smtp"
        End Select

        Try
            Select Case DefaultSoft
                Case "Outlook Express"

                    SendMail = MAPISendMailOE(0, 0, MAPI_Message, MAPI_recip, MAPI_file, Dialog, 0)

                Case "Microsoft Outlook", "Outlook", "Microsoft Office Outlook"

                    Logon("Outlook", "")

                    SendMail = MAPISendMail(zlSessionID, 0, MAPI_Message, MAPI_recip, MAPI_file, Dialog, 0)

                    LogOff()
                    'Case 

                    'Logon12("Outlook", "")

                    'SendMail = MAPISendMailO12(zlSessionID, 0, MAPI_Message, MAPI_recip, MAPI_file, Dialog, 0)

                    'LogOff12()

                Case "Windows Mail"

                    SendMail = MAPISendMailWM(0, 0, MAPI_Message, MAPI_recip, MAPI_file, Dialog, 0)

                Case "Smtp"
                    If MailFrom.LastIndexOf("@") = -1 Or MailFrom.LastIndexOf(".") = -1 Then
                        Throw New Exception("Adresse Expéditeur Mal orthographiée, ou non renseigné" + vbCrLf + "Vous pouvez la définir pour chaque utilisateur dans Administration - Les Renseignements utilisateur")
                        Return False
                    End If
                    Dim Mail As New System.Net.Mail.MailMessage
                    Mail.To.Add(MailTo)
                    Mail.From = New System.Net.Mail.MailAddress(MailFrom)
                    Mail.Subject = Subject
                    Mail.Body = Body
                    If Not Attachments Is Nothing Then
                        For X = 0 To Attachments.Length - 1
                            Mail.Attachments.Add(New System.Net.Mail.Attachment(Attachments(X)))
                        Next
                    End If

                    Try
                        Dim Smtp As New System.Net.Mail.SmtpClient(Host)
                        Smtp.Send(Mail)
                    Catch
                        Throw New Exception("L'hôte SMTP n'a pas été défini, vous pouvez le faire dans Administration - Paramètres Généraux")
                    End Try
            End Select
        Catch ex As Exception
            Throw ex
        End Try
        Return True

    End Function

    Private Function CountWords(ByVal st As String, ByVal Ch As Char) As Integer
        If st = Nothing Then Return 0
        st = st.Trim
        If st.LastIndexOf(Ch) = st.Length - 1 Then st = st.Remove(st.Length - 1, 1)
        Return st.Split(Ch).Length
    End Function

    '----------------------------------------------------------------------------------------------------------'
    '               je sais plus
    '----------------------------------------------------------------------------------------------------------'
    Private Sub Class_Initialize_Renamed()
        zlShowDialogs = MAPI_DIALOG
        zlParentHwnd = GetActiveWindow 'Seed parent window handle
    End Sub

    '----------------------------------------------------------------------------------------------------------'
    '               Connection au compte MAPI Outlook (pas Express)
    '----------------------------------------------------------------------------------------------------------'
    Private Sub Logon(Optional ByRef zsusername As String = Nothing, Optional ByRef zspassword As String = "")
        ' renvoit 0 si ok
        Dim lReturnValue As Integer

        If zsusername = Nothing Then
            zsusername = "Outlook"
            zspassword = ""
        End If

        Class_Initialize_Renamed()
        Try
            If zlSessionID Then
                'End existing session
                LogOff()
                zlSessionID = 0
            End If
            zlSessionID = 0
            lReturnValue = MAPILogon(zlParentHwnd, zsusername, zspassword, MAPI_LOGON_UI, 0, zlSessionID)
        Catch ex As Exception

        End Try
    End Sub

    Private Sub Logon12(Optional ByRef zsusername As String = Nothing, Optional ByRef zspassword As String = "")
        ' renvoit 0 si ok
        Dim lReturnValue As Integer

        If zsusername = Nothing Then
            zsusername = "Outlook"
            zspassword = ""
        End If

        Class_Initialize_Renamed()
        Try
            If zlSessionID Then
                'End existing session
                LogOff()
                zlSessionID = 0
            End If
            zlSessionID = 0
            lReturnValue = MAPILogon12(zlParentHwnd, zsusername, zspassword, MAPI_LOGON_UI, 0, zlSessionID)
        Catch ex As Exception

        End Try
    End Sub

    '----------------------------------------------------------------------------------------------------------'
    '               Deconnection du compte
    '----------------------------------------------------------------------------------------------------------'
    Private Function LogOff() As Integer 'retourne 0 si ok
        If zlSessionID Then
            Return MAPILogoff(zlSessionID, zlParentHwnd, 0, 0)
            zlSessionID = 0
        End If
    End Function

    Private Function LogOff12() As Integer 'retourne 0 si ok
        If zlSessionID Then
            Return MAPILogoff12(zlSessionID, zlParentHwnd, 0, 0)
            zlSessionID = 0
        End If
    End Function

End Class

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_PHILIPPO)