Tipp-Upload: VB.NET 0275: Mime-Typ eines Attachments angeben

Hinweis zum Tippvorschlag  

Dieser Vorschlag wurde noch nicht auf Sinn und Inhalt überprüft und die Zip-Datei wurde noch nicht auf schädlichen Inhalt hin untersucht.
Bitte haben Sie ein wenig Geduld, bis die Freigabe erfolgt.

Über den Tipp  

Dieser Tippvorschlag ist noch unbewertet.

Der Vorschlag ist in den folgenden Kategorien zu finden:

• Sonstiges

Dem Tippvorschlag wurden folgende Schlüsselwörter zugeordnet:
Mime-Typ, Attachment, e-mail

Der Vorschlag wurde erstellt am: 20.05.2008 19:58.
Die letzte Aktualisierung erfolgte am 23.05.2008 22:05.

Zurück zur Übersicht

Beschreibung  

Da .NET nur eine sehr begrenzte Anzahl an Mime-Types hat, sucht dieses Programm zunächst in der Registry nach dem "Content Type" für die Dateiendung. Wird er hier nicht gefunden wird in der Liste der Seite SelfHTML: MIME-Typen gesucht. Außerdem der Anhang ohne Pfadangabe übertragen. Die drei Listboxen für Postausgangserver, Empfänger und Absender sind zu Beginn noch leer und sollten zur Bequemlichkeit vor dem Start gefüllt werden.

Schwierigkeitsgrad

Verwendete API-Aufrufe:

Download: Download des Beispielprojektes [19,30 KB]

' Dieser Source stammt von http://www.activevb.de
' und kann frei verwendet werden. Für eventuelle Schäden
' wird nicht gehaftet.

' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
' Ansonsten viel Spaß und Erfolg mit diesem Source!
'
' Beachten Sie, das vom Designer generierter Code hier ausgeblendet wird.
' In den Zip-Dateien ist er jedoch zu finden.

' ------------ Anfang Projektgruppe MailTest.sln  ------------
' ----------- Anfang Projektdatei MailTest.vbproj  -----------
' ------------------ Anfang Datei Form1.vb  ------------------
Option Explicit On
Option Strict On

Imports System.Net.Mail
Imports System.Windows.Forms
Imports Microsoft.Win32

Public Class frmMail

    Dim anzDateiName As Integer    ' Anzahl der Attachments
    Dim DateinameLang() As String  ' Dateiname mit Pfandangabe
    Dim DateinameKurz() As String   ' Dateiname ohne Pfad für ContentDisposition.FileName
    Dim Dateiendung() As String      ' z.B. ".jpg" zur Ermittlung des Mime-Typ

    Private Sub btnSendMail_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _
        Handles btnSendMail.Click

        Mail_Erstellen()

    End Sub

    Private Sub txbNachricht_GotFocus(ByVal sender As Object, ByVal e As System.EventArgs) _
        Handles txbNachricht.GotFocus

        txbNachricht.SelectionStart = 1

    End Sub

    Private Sub Mail_Erstellen()

        Dim an As String
        Dim von As String
        Dim Betreff As String
        Dim Nachricht As String
        Dim Host As String

        Dim i As Integer

        an = lbxTo.Items.Item(lbxTo.TopIndex).ToString
        von = lbxFrom.Items.Item(lbxFrom.TopIndex).ToString
        Betreff = txbBetreff.Text
        Nachricht = txbNachricht.Text
        Host = lbxHost.Items.Item(lbxHost.TopIndex).ToString

        Dim myMessage As New MailMessage()
        Dim myClient As New SmtpClient()

        myMessage.From = New MailAddress(von)
        myMessage.To.Add(New MailAddress(an))
        myMessage.Subject = Betreff
        myMessage.Body = Nachricht
        myClient.Host = Host

        For i = 0 To lbxAttachments.Items.Count - 1

            Dim NamenTyp As String

            NamenTyp = myMediaTypeNames(Dateiendung(i))

            Dim myAttachment As New Attachment(DateinameLang(i), NamenTyp)

            myAttachment.ContentDisposition.FileName = DateinameKurz(i)
            myMessage.Attachments.Add(myAttachment)
        Next

        Try

            myClient.Send(myMessage)
            MessageBox.Show("Die Nachricht wurde erfolgreich gesendet.")

            Exit Sub

        Catch ex As Exception

            MessageBox.Show("Fehler bei der Übertragung: " & ex.Message)

        End Try

    End Sub

    Private Function myMediaTypeNames(ByVal Erweiterung As String) As String

        Dim MeinKey As RegistryKey
        Dim MeinName As String

        myMediaTypeNames = ""
        MeinName = ""
        MeinKey = Registry.ClassesRoot.OpenSubKey(Erweiterung)

        If MeinKey IsNot Nothing Then

            ' #####################################################
            ' ######### mal sehen, ob die Registry einen passenden Mime-Typ hat #########
            ' #####################################################

            MeinName = CStr(MeinKey.GetValue("Content Type"))
            MeinKey.Close()

            If MeinName <> "" Then
                Return MeinName

            Else

                MeinName = FindeInListe(Erweiterung)
                Return MeinName
            End If

        Else

            ' #####################################################
            ' ############ wenn nicht, kucken wir in der langen Liste nach ############
            ' #####################################################

            MeinName = FindeInListe(Erweiterung)
            Return MeinName

        End If

    End Function

    Private Function FindeInListe(ByVal Erweiterung As String) As String

        ' folgende Mime-Typen sind der Seite http://de.selfhtml.org/diverses/mimetypen.htm entnommen

        Select Case Erweiterung

            Case ".dwg"
                Return "application/acad"

            Case ".asd", ".asn"
                Return "application/astound"

            Case ".tsp"
                Return "application/dsptype"

            Case ".dxf"
                Return "application/dxf"

            Case ".spl"
                Return "application/futuresplash"

            Case ".gz"
                Return "application/gzip"

            Case ".ptlk"
                Return "application/listenup"

            Case ".hpx"
                Return "application/mac-binhex40"

            Case ".mbd"
                Return "application/mbedlet"

            Case ".mif"
                Return "application/mif"

            Case ".xls", ".xla"
                Return "application/msexcel"

            Case ".hlp", ".chm"
                Return "application/mshelp"

            Case ".ppt", ".ppz", ".pps", ".pot"
                Return "application/mspowerpoint"

            Case ".doc", ".dot"
                Return "application/msword"

            Case ".bin", ".exe", ".com", ".dll", ".class"
                Return "application/octet-stream"

            Case ".oda"
                Return "application/oda"

            Case ".pdf"
                Return "application/pdf"

            Case ".ai", ".eps", ".ps"
                Return "application/postscript"

            Case ".rtc"
                Return "application/rtc"

            Case ".rtf"
                Return "application/rtf"

            Case ".smp"
                Return "application/studiom"

            Case ".tbk"
                Return "application/toolbook"

            Case ".vmd"
                Return "application/mac-binhex40"

            Case ".vmf"
                Return "application/vocaltec-media-desc"

            Case ".htm", ".html", ".shtml", ".xhtml"
                Return "application/xhtml+xml"

            Case ".xml"
                Return "application/xml"

            Case ".bcpio"
                Return "application/x-bcpio"

            Case ".z"
                Return "application/x-compress"

            Case ".cpio"
                Return "application/x-cpio"

            Case ".csh"
                Return "application/x-csh"

            Case ".dcr", ".dir", ".dxr"
                Return "application/x-director"

            Case ".dvi"
                Return "application/x-dvi"

            Case ".evy"
                Return "application/x-envoy"

            Case ".gtar"
                Return "application/x-gtar"

            Case ".hdf"
                Return "application/x-hdf"

            Case ".php", ".phtml"
                Return "application/x-httpd-php"

            Case ".js"
                Return "application/x-javascript"

            Case ".latex"
                Return "application/x-latex"

            Case ".bin"
                Return "application/x-macbinary"

            Case ".mif"
                Return "application/x-mif"

            Case ".nc", ".cdf"
                Return "application/x-netcdf"

            Case ".nsc"
                Return "application/x-nschat"

            Case ".sh"
                Return "application/x-sh"

            Case ".shar"
                Return "application/x-shar"

            Case ".swf", ".cab"
                Return "application/x-shockwave-flash"

            Case ".spr", ".sprite"
                Return "application/x-sprite"

            Case ".sit"
                Return "application/x-stuffit"

            Case ".sca"
                Return "application/x-supercard"

            Case ".sv4cpio"
                Return "application/x-sv4cpio"

            Case ".sv4crc"
                Return "application/x-sv4crc"

            Case ".tar"
                Return "application/x-tar"

            Case ".tcl"
                Return "application/x-tcl"

            Case ".tex"
                Return "application/x-tex"

            Case ".texinfo", ".texi"
                Return "application/x-texinfo"

            Case ".t", ".tr", ".roff"
                Return "application/x-troff"

            Case ".man", ".troff"
                Return "application/x-troff-man"

            Case ".me", ".troff"
                Return "application/x-troff-me"

            Case ".ms", ".troff"
                Return "application/x-troff-ms"

            Case ".ustar"
                Return "application/x-ustar"

            Case ".src"
                Return "application/x-wais-source"

            Case ".zip"
                Return "application/zip"

            Case ".au", ".snd"
                Return "audio/basic"

            Case ".es"
                Return "audio/echospeech"

            Case ".tsi"
                Return "audio/tsplayer"

            Case ".vox"
                Return "audio/voxware"

            Case ".aif", ".aiff", ".aifc"
                Return "audio/x-aiff"

            Case ".dus", ".cht"
                Return "audio/dspeeh"

            Case ".mid", ".midi"
                Return "audio/x-midi"

            Case ".mp2"
                Return "audio/x-mpeg"

            Case ".ram", ".ra"
                Return "audio/x-pn-realaudio"

            Case ".stream"
                Return "audio/x-qp-stream"

            Case ".wav"
                Return "audio/x-wav"

            Case ".dwf"
                Return "drawing/x-dwf"

            Case ".cod"
                Return "image/cis-cod"

            Case ".ras"
                Return "image/cmu-raster"

            Case ".fif"
                Return "image/fif"

            Case ".gif"
                Return "image/gif"

            Case ".ief"
                Return "image/ief"

            Case ".jpeg", ".jpg", ".jpe"
                Return "image/jpeg"

            Case ".png"
                Return "image/png"

            Case ".tiff", ".tif"
                Return "image/tiff"

            Case ".mcf"
                Return "image/vasa"

            Case ".wbmp"
                Return "image/xdwf"

            Case ".fh4", ".fh5", ".fhc"
                Return "image/x-freehand"

            Case ".ico"
                Return "image/x-icon"

            Case ".pnm"
                Return "image/x-portable-anymap"

            Case ".pbm"
                Return "image/x-portable-bitmap"

            Case ".pgm"
                Return "image/x-portable-graymap"

            Case ".ppm"
                Return "image/x-portable-pixmap"

            Case ".rgb"
                Return "image/x-rgb"

            Case ".xwd"
                Return "image/x-windowdump"

            Case ".xbm"
                Return "image/x-xbitmap"

            Case ".xpm"
                Return "image/x-xpixmap"

            Case ".wrl"
                Return "model/vrml"

            Case ".csv"
                Return "text/comma-seperated-values"

            Case ".css"
                Return "text/css"

            Case ".htm", ".html", ".shtml"
                Return "text/html"

            Case ".js"
                Return "text/javascript"

            Case ".txt"
                Return "text/plain"

            Case ".rtx"
                Return "text/richtext"

            Case ".rtf"
                Return "text/rtf"

            Case ".tsv"
                Return "text/tab-seperated-values"

            Case ".wml"
                Return "text/vnd.wap.wml"

            Case ".wmlc"
                Return "application/vnd.wap.wmlc"

            Case ".wmls"
                Return "text/vnd.wap.wmlscript"

            Case ".wmlsc"
                Return "application/vnd.wap.wmlscriptc"

            Case ".xml"
                Return "text/xml"

            Case ".etx"
                Return "text/x-setext"

            Case ".sgm", ".sgml"
                Return "text/x-sgml"

            Case ".talk", ".spc"
                Return "text/x-speech"

            Case ".mpeg", ".mpg", ".mpe"
                Return "video/mpeg"

            Case ".qt", ".mov"
                Return "video/quicktime"

            Case ".viv", ".vivo"
                Return "video/vnd.vivo"

            Case ".avi"
                Return "video/x-msvideo"

            Case ".movie"
                Return "video/x-sgi-movie"

            Case ".vts", ".vtts"
                Return "workbook/formulaone"

            Case ".3dmf", ".3dm", ".qd3d", ".qd3"
                Return "x-world/x-3dmf"

            Case ".wrl"
                Return "x-world/x-vrml"

        End Select

    End Function

    Private Sub btnAddAttachment_Click(ByVal sender As System.Object, ByVal e As _
        System.EventArgs) Handles btnAddAttachment.Click

        Dim i As Integer
        Dim Help() As String
        Dim dateiÖffnenDialog As New OpenFileDialog

        With dateiÖffnenDialog
            .Multiselect = True
            .CheckFileExists = True
            .CheckPathExists = True
            .DefaultExt = "*.jpg"

            .Filter = "Bilddateien (*.jpg;*.bmp)|*.jpg;*.bmp|Textdateien " & _
                "(*.txt;*.html)|*.txt;*.html|Alle Dateien (*.*)|*.*"

            Dim dialogErgebnis As DialogResult = .ShowDialog

            If dialogErgebnis = Windows.Forms.DialogResult.Cancel Then

                Exit Sub

            Else

                For i = 0 To .FileNames.Length - 1
                    anzDateiName += 1
                    ReDim Preserve DateinameLang(anzDateiName)
                    ReDim Preserve DateinameKurz(anzDateiName)
                    ReDim Preserve Dateiendung(anzDateiName)
                    DateinameLang(anzDateiName) = .FileNames(i)
                    Help = Split(.FileNames(i), "\")
                    DateinameKurz(anzDateiName) = Help(UBound(Help))
                    Help = Split(.FileNames(i), ".")
                    Dateiendung(anzDateiName) = "." & Help(UBound(Help)).ToLower
                    lbxAttachments.Items.Add(DateinameKurz(anzDateiName))
                Next i

                btnDelete.Enabled = True
                btnDeleteAll.Enabled = True
            End If

        End With

    End Sub

    Private Sub frmMail_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) _
        Handles MyBase.Load

        Me.Show()
        txbBetreff.Text = My.Settings.Betreff
        txbNachricht.Text = My.Settings.Nachricht
        anzDateiName = -1

        If lbxFrom.Items.Count = 0 Then

            MessageBox.Show("Bitte mindestens einen Absender in der Listbox" & vbCrLf & _
                """lbxFrom""eintragen!")

            lbxFrom.Items.Add(InputBox("Bitte einen Absender eingeben"))

            If lbxFrom.Items.Count = 0 Then

                End
            End If
        End If

        If lbxTo.Items.Count = 0 Then

            MessageBox.Show("Bitte mindestens einen Empfänger in der Listbox" & vbCrLf & _
                """lbxTo""eintragen!")

            lbxTo.Items.Add(InputBox("Bitte einen Empfänger eingeben"))

            If lbxTo.Items.Count = 0 Then

                End
            End If
        End If

        If lbxHost.Items.Count = 0 Then

            MessageBox.Show("Bitte mindestens einen Postausgangsserver in der Listbox" & _
                vbCrLf & """lbxHost""eintragen!")

            lbxHost.Items.Add(InputBox("Pausgansserver, z.B. smtp.web.de, eingeben"))

            If lbxHost.Items.Count = 0 Then

                End
            End If
        End If

    End Sub

    Private Sub frmMail_FormClosing(ByVal sender As System.Object, ByVal e As _
        System.Windows.Forms.FormClosingEventArgs) Handles MyBase.FormClosing

        My.Settings.Betreff = txbBetreff.Text
        My.Settings.Nachricht = txbNachricht.Text

    End Sub

    Private Sub btnDelete_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _
        Handles btnDelete.Click

        Dim i As Integer

        With lbxAttachments

            If .SelectedIndex = -1 Then
                MessageBox.Show("Bitte etwas auswählen!")

            Else

                For i = .SelectedIndex + 1 To anzDateiName
                    DateinameLang(i - 1) = DateinameLang(i)
                    DateinameKurz(i - 1) = DateinameKurz(i)
                    Dateiendung(i - 1) = Dateiendung(i)
                Next

                anzDateiName -= 1
                ReDim Preserve DateinameLang(anzDateiName)
                ReDim Preserve DateinameKurz(anzDateiName)
                ReDim Preserve Dateiendung(anzDateiName)
                .Items.Remove(.Items(.SelectedIndex))

                If .Items.Count = 0 Then
                    btnDelete.Enabled = False
                    btnDeleteAll.Enabled = False
                End If
            End If

        End With

    End Sub

    Private Sub btnDeleteAll_Click(ByVal sender As System.Object, ByVal e As _
        System.EventArgs) Handles btnDeleteAll.Click

        lbxAttachments.Items.Clear()
        btnDelete.Enabled = False
        btnDeleteAll.Enabled = False
        anzDateiName = -1
        ReDim DateinameLang(0)
        ReDim DateinameKurz(0)
        ReDim Dateiendung(0)

    End Sub

    Private Sub btnAddHost_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _
        Handles btnAddHost.Click

        lbxHost.Items.Add(InputBox("Pausgansserver, z.B. smtp.web.de, eingeben"))

    End Sub

    Private Sub btnDelHost_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _
        Handles btnDelHost.Click

        lbxHost.Items.Remove(lbxHost.Items.Item(lbxHost.TopIndex))

        If lbxHost.Items.Count = 0 Then
            btnAddHost_Click(sender, e)
        End If

    End Sub

    Private Sub btnAddFrom_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _
        Handles btnAddFrom.Click

        lbxFrom.Items.Add(InputBox("Bitte einen Absender eingeben"))

    End Sub

    Private Sub btnDelFrom_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _
        Handles btnDelFrom.Click

        lbxFrom.Items.Remove(lbxFrom.Items.Item(lbxFrom.TopIndex))

        If lbxFrom.Items.Count = 0 Then
            btnAddFrom_Click(sender, e)
        End If

    End Sub

    Private Sub btnAddTo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _
        Handles btnAddTo.Click

        lbxFrom.Items.Add(InputBox("Bitte einen Empfänger eingeben"))

    End Sub

    Private Sub btnDelTo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _
        Handles btnDelTo.Click

        lbxTo.Items.Remove(lbxTo.Items.Item(lbxTo.TopIndex))

        If lbxFrom.Items.Count = 0 Then
            btnAddTo_Click(sender, e)
        End If

    End Sub

End Class

' ------------------- Ende Datei Form1.vb  -------------------
' ------------ Ende Projektdatei MailTest.vbproj  ------------
' ------------- Ende Projektgruppe MailTest.sln  -------------

	

Diskussion  

Diese Funktion ermöglicht es, Fragen, die die Veröffentlichung des Tipps betreffen, zu klären, oder Anregungen und Verbesserungsvorschläge einzubringen. Nach der Veröffentlichung des Tipps werden diese Beiträge nicht weiter verlinkt. Allgemeine Fragen zum Inhalt sollten daher hier nicht geklärt werden.
Folgende Diskussionen existieren bereits

Um eine Diskussion eröffnen zu können, müssen sie angemeldet sein.