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 = '"ＳＭＴＰメールサーバ"
strDomain = "mk" '"貴方のＰＣ名"
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-ｊｐ形式
このようにしないと文字化けする
'これが通常のiso-2022-ｊｐ形式のエンコード
’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
|