2005 ソケットでSMTPメール送信。基本


VB Tips And Sample(HOME)(VB.NET Sample インデックス)




smtpMailクラスは98se、ME、などCDOがないOSでは使えません。
で、2005からはそれにとって変わるクラスが追加されたのですが、ソケットに戻って基本どおりにすれば
そんなクラスは使わなくても98SEでもうごくようになります。

Imports System
Imports System.Text
Imports System.Net.Sockets

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        'SMTP接続 めーる送信


        Dim sk As New Net.Sockets.TcpClient()
        Dim stream As NetworkStream
        Dim msg As String
        Dim strHost As String
        Dim strDomain As String
        Dim strFrom As String
        Dim strTo As String
        Dim strSubject As String
        Dim stBody As String
        Dim strData As String



        strHost =  '"SMTPメールサーバ"
        strDomain = "mk" '"貴方のPC名"
        strFrom =  '"貴方のメアド"
        strTo =  '"あて先メアド"
        strSubject = "テスト件名" ' Text2.Text '件名
        stBody = Me.TextBox1.Text ' "テスト件名" & vbCrLf & "98あかさたなはまやわら" 'Text1.Text '内容

        Try

             ’無限ループ回避用
            sk.SendTimeout = 20 * 1000 '20秒
            sk.ReceiveTimeout = 20 * 1000 '20秒

            'メールサーバに接続
            sk.Connect(strHost, 25)
            '受信
            stream = sk.GetStream()
            msg = ReceiveData(stream)
            Debug.WriteLine(msg)
            If msg.StartsWith("220") = False Then
                Exit Sub
            End If
            '挨拶の送信
            SendData(stream, "EHLO " & strDomain & vbCrLf)
            '受信
            stream = sk.GetStream()
            msg = ReceiveData(stream)
            Debug.WriteLine(msg)
            If msg.StartsWith("250") = False Then
                Exit Sub
            End If

            'Fromの送信
            SendData(stream, "MAIL FROM:" & strFrom & vbCrLf)
            '受信
            stream = sk.GetStream()
            msg = ReceiveData(stream)
            Debug.WriteLine(msg)
            If msg.StartsWith("250") = False Then
                Exit Sub
            End If

            'あて先の送信
            SendData(stream, "RCPT TO:" & strTo & vbCrLf)
            '受信
            stream = sk.GetStream()
            msg = ReceiveData(stream)
            Debug.WriteLine(msg)
            If msg.StartsWith("250") = False Then
                Exit Sub
            End If

            'Dataの送信(これから送ってもいいかい?)
            SendData(stream, "DATA" + vbCrLf)
            '受信
            stream = sk.GetStream()
            msg = ReceiveData(stream)
            Debug.WriteLine(msg)
            If msg.StartsWith("354") = False Then
                Exit Sub
            End If

            'base64エンコード
            strSubject = "=?iso-2022-jp?b?" & b64(strSubject) & "?="
            'もしくはエンコードしなくても文字化けはしない? OEでは問題ない
            その場合は stream.Write(shiftbyte(strData〜でおくると良い。  


            strData = "From: ""lop"" <" & strFrom & ">" & vbCrLf & _
            "To: <" & strTo & ">" & vbCrLf & _
            "Subject: " & strSubject & vbCrLf & _
            "Date: " & System.DateTime.Today.DayOfWeek.ToString & Format(Now, " ,d MMM yyyy hh:mm:ss") & " +0900 (JST)" & vbCrLf & _
            "MIME-Version: 1.0" & vbCrLf & _
            "Content-Type: text/plain;" & vbCrLf & _
            "    charset=""shift_jis"";" & vbCrLf & _
            "    reply-type=original" & vbCrLf & _
            "Content-Transfer-Encoding: 7bit" & vbCrLf & _
            "X-Priority: 3" & vbCrLf & _
            "X-MSMail-Priority: Normal" & vbCrLf


            'ヘッダの送信
            SendData(stream, strData & vbCrLf)これだと曜日が文字化け?
            ’このようにしないと文字化けする テストでOEでは問題ない
            stream.Write(shiftbyte(strData & vbCrLf), 0, shiftbyte(strData).Length+1)
            
            '内容の送信
            'SendData(stream, stBody & vbCrLf)
            'shift_jis形式このようにしないと文字化けする
            stream.Write(shiftbyte(stBody & vbCrLf), 0, shiftbyte(stBody).Length+1)
            
            'iso-2022-jp形式
            このようにしないと文字化けする
            'これが通常のiso-2022-jp形式のエンコード
            ’charset=""iso-2022-jp"";"にしておく 
            stream.Write(iso2022byte(stBody & vbCrLf), 0, iso2022byte(stBody).Length + 1)


            SendData(stream, vbCrLf & "." & vbCrLf)

            '受信
            stream = sk.GetStream()
            msg = ReceiveData(stream)
            Debug.WriteLine(msg)
            If msg.StartsWith("250") = False Then
                Exit Sub
            End If

            '終了の送信
            SendData(stream, "QUIT " & vbCrLf)
            '受信
            stream = sk.GetStream()
            msg = ReceiveData(stream)
            Debug.WriteLine(msg)
            If msg.StartsWith("221") = False Then
                Exit Sub
            End If

            sk.Close()
            MessageBox.Show("送信しました")

        Catch ex As Exception
            MessageBox.Show(ex.ToString)

        End Try

    End Sub

ここからどぼんさんのサンプルを引用↓

    'データを受信する
    Private Overloads Shared Function ReceiveData( _
            ByVal stream As NetworkStream, _
            ByVal multiLines As Boolean, _
            ByVal bufferSize As Integer, _
            ByVal enc As Encoding) As String
        Dim data(bufferSize - 1) As Byte
        Dim len As Integer
        Dim msg As String = ""
        Dim ms As New System.IO.MemoryStream()

        'すべて受信する
        '(無限ループに陥る恐れあり)
        Do
            '受信
            len = stream.Read(data, 0, data.Length)
            ms.Write(data, 0, len)
            '文字列に変換する
            msg = enc.GetString(ms.ToArray())
        Loop While stream.DataAvailable Or ((Not multiLines Or msg.StartsWith("-ERR")) And Not msg.EndsWith(vbCrLf)) Or (multiLines And Not msg.EndsWith(vbCrLf + "." + vbCrLf))

        ms.Close()

        '"-ERR"を受け取った時は例外をスロー
        If msg.StartsWith("-ERR") Then
            Throw New ApplicationException("Received Error")
        End If
        '表示
        'Console.Write(("S: " + msg))

        Return msg
    End Function 'ReceiveData
    Private Overloads Shared Function ReceiveData( _
            ByVal stream As NetworkStream, _
            ByVal multiLines As Boolean, _
            ByVal bufferSize As Integer) As String
        Return ReceiveData(stream, multiLines, bufferSize, _
            Encoding.GetEncoding(50220))
    End Function 'ReceiveData

    Private Overloads Shared Function ReceiveData( _
            ByVal stream As NetworkStream, _
            ByVal multiLines As Boolean) As String
        Return ReceiveData(stream, multiLines, 256)
    End Function 'ReceiveData

    Private Overloads Shared Function ReceiveData( _
            ByVal stream As NetworkStream) As String
        Return ReceiveData(stream, False)
    End Function 'ReceiveData

    'データを送信する
    Private Overloads Shared Sub SendData(ByVal stream As NetworkStream, ByVal msg As String, ByVal enc As Encoding)
        'byte型配列に変換
        Dim data As Byte() = enc.GetBytes(msg)
        '送信
        stream.Write(data, 0, data.Length)

        '表示
        'Console.Write(("C: " + msg))
    End Sub 'SendData
    Private Overloads Shared Sub SendData(ByVal stream As NetworkStream, ByVal msg As String)
        SendData(stream, msg, Encoding.ASCII)
    End Sub 'SendData
ここまでどぼんさんのサンプルを引用↑

    Private Function b64(ByVal str As String) As String
        'BASE64文字列にして返す
        Dim strByte As Byte() = System.Text.Encoding.GetEncoding("shift_jis").GetBytes(str)
        b64 = System.Convert.ToBase64String(strByte)

        Debug.WriteLine(b64)

    End Function

    Private Function shiftbyte(ByVal str As String) As Byte()
        '単なるバイト文字列にして返す
        shiftbyte = System.Text.Encoding.GetEncoding("shift_jis").GetBytes(str)
    End Function

    Private Function iso2022byte(ByVal str As String) As Byte()
        '単なるバイト文字列にして返す
        iso2022byte = System.Text.Encoding.GetEncoding("iso-2022-jp").GetBytes(str)
    End Function



End Class



VB Tips And Sample(HOME)(VB.NET Sample インデックス)