如何发送EMAIL？（指定内容或指定附件），

Question

SMTP协议非常简单实在不想再多费口舌。
下面是我写的一段发送邮件控件的源代码的核心部分，没有优化而且时临时摘出来的有些东东没定义，你把它删掉就行，你看看吧
Private Sub wskSend_DataArrival(ByVal bytesTotal As Long)
    On Error Resume Next
    wskSend.GetData Response ' Check for incoming response *IMPORTANT*
End SubPrivate Sub wskSend_SendComplete()
        IsSendComplete = True
End SubPrivate Sub wskSend_SendProgress(ByVal bytesSent As Long, ByVal bytesRemaining As Long)
        IsSendComplete = IsSendComplete
End SubPrivate Sub SendEmailFile(DATA As String, MailServerName As String, Port As String, FromEmailAddress As String, ToEmailAddress() As String)
Dim Temp As String
Dim DateNow As String
Dim First As String
Dim Second As String
Dim Rate As Integer
Dim I As LongwskSend.Close
wskSend.LocalPort = 0
PB.Value = 0
timMov.Interval = 150
sStop = False
If wskSend.State = sckClosed Then
            DateNow = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") & "" & " -0800"
            
            First = "mail from:" + Chr(32) + FromEmailAddress + vbCrLf
            
            wskSend.Close
            wskSend.Protocol = sckTCPProtocol
            wskSend.RemoteHost = MailServerName  '"192.168.0.101"
            wskSend.RemotePort = CInt(Port)
            wskSend.Connect
            
            If Not WaitFor("220") Then Exit Sub
            
            PutState "正在连接 SMTP 服务器 ..."
            If sStop Then Exit Sub
            wskSend.SendData ("HELO worldcomputers.com" + vbCrLf)
        
            If Not WaitFor("250") Then Exit Sub
        
            PutState "已经连接服务器"
            If sStop Then Exit Sub
            wskSend.SendData (First)
            
            PutState "正在发送信笺内容"
        
            If Not WaitFor("250") Then Exit Sub
            If sStop Then Exit Sub
            For I = LBound(ToEmailAddress) To UBound(ToEmailAddress)
                Second = "rcpt to:" + Chr(32) + ToEmailAddress(I) + vbCrLf
                wskSend.SendData (Second)
                If Not WaitFor("250") Then Exit Sub
            Next I
        
            If sStop Then Exit Sub
            wskSend.SendData ("data" + vbCrLf)
            
            If Not WaitFor("354") Then Exit Sub
        
            If sStop Then Exit Sub
            Dim s As String
            Dim iLen As Long
            I = 1
            iLen = Len(DATA)
            Do While (I <= iLen)
                PutState CStr(Rate) & "%", Rate
                If sStop Then Exit Sub
                wskSend.SendData Mid(DATA, I, 2000)
                I = I + 2000
                Rate = 100 * (I / iLen)
                If WaitForSendComplete = False Then
                    Exit Sub
                End If
            Loop
            If sStop Then Exit Sub
            wskSend.SendData (vbCrLf + "." + vbCrLf)
            If Not WaitFor("250") Then Exit Sub
            If sStop Then Exit Sub
            wskSend.SendData ("quit" + vbCrLf)
            
            PutState "正在与服务器断开连接"
            
            If Not WaitFor("221") Then Exit Sub
            
            wskSend.Close
            PutState "发送成功。"
            timMov.Interval = 0
            PB.Value = 100
            wskSend.Close
Else
           PutState "发送信件过程中出错。"
End If
End SubPrivate Function WaitFor(ResponseCode As String) As Boolean
Dim start
Dim Tmr
    Response = "" ' Sent response code to blank **IMPORTANT**
    start = Timer ' Time event so won't get stuck in loop
    WaitFor = True
    Do While Response = ""
        If sStop Then Exit Function
        Tmr = Timer - start
        DoEvents
'        DoEvents
'        DoEvents ' Let System keep checking for incoming response **IMPORTANT**
        If Tmr > 50 Then ' Time in seconds to wait
            MsgBox "服务器相应超时!", vbOKOnly, "蓝鸽-SMTP 1.0b"
            WaitFor = False
            Exit Function
        End If
    Loop
'    While Left(Response, 3) <> ResponseCode
'        DoEvents
'        If Tmr > 50 Then
'            MsgBox "服务器响应错误!", vbOKOnly
'            WaitFor = False
'            Exit Function
'        End If
'    Wend
    If Left(Response, 3) <> ResponseCode Then
        DoEvents
        If sStop Then Exit Function
        MsgBox "服务器不接受指令： " & Mid(Response, 4), vbOKOnly, "蓝鸽-SMTP 1.0b"
        WaitFor = False
        Exit Function
    End If
End FunctionPrivate Function WaitForSendComplete() As Boolean
Dim start
Dim Tmr
    start = Timer ' Time event so won't get stuck in loop
    Do While IsSendComplete = False
        If sStop Then Exit Function
        Tmr = Timer - start
        DoEvents
        If Tmr > 10 Then
                WaitForSendComplete = False
                IsSendComplete = False
                Exit Function
        End If
    Loop
    WaitForSendComplete = True
    IsSendComplete = False
End Function

Answer 1

至于附件请看下面代码。
呕不！太长了总之你看一下MIME协议的RFC吧

更长
还使用Microsoft MAPI Controls中的MAPIMessage控件吧。点一下属性方法很容易懂。

Answer 2

哈哈，我有现成的。
不过是DELPHI编写的。

Answer 3

wyo(欧亚大陆桥),真牛x,不过我喜欢自信的人，你要先写出代码，我要分两次付分，决不食言（我一次只能107分了）。如果食言，你可以骂我，这么这@@盯着的呀！[email protected]

Answer 4

OK。明天就给。是可以发送附件的E-MAIL源代码。很大，不能贴出来，发到你信箱。

Answer 5

现在我正在收取，的确好大，不要给我炸弹啊，据说某些人在这里散布木马程序，混蛋！！
wyo(欧亚大陆桥)，如果能用，明天我会告诉你来领分的，谢谢了！

Answer 6

我怎么没收到你的？
wyo(欧亚大陆桥)

Answer 7

我发到了[email protected] 
如果你明天还手不到,我上摘到望上给你下在!!!

Answer 8

wyo(欧亚大陆桥),我已收到，先让我看看，一定给分，不要急。南海佬也发了一个给我，我已付了100分给他，不过他的未能全部满足我的要求，但我还会给他一些分的，你不会等不及吧？明天上班后给分给你，先谢了！　

Answer 9

WYO（欧亚大陆桥），你和unruledboy(南海佬),发送给我的代码完全一样，所以不能给一个人200分，每个人150分吧！
请到下面URL领取另外的100分！！！
http://www.csdn.net/expert/topic/138/138173.shtm

Answer 10

南海佬这家伙，年纪大了，走路真慢呀，到现在还没来领分，叫我这颁奖大会怎么开呀？
只好先委屈一下WYO（欧亚大陆桥），你多等会儿吧，你的交通便利，人家要从南海赶来，多不容易呀!^_^!
@_@

Answer 11

我也要源代码!
[email protected]
我会给你分的!

Answer 12

to shawls(小山)　
发到你信箱了,给100分.我也要混进专家榜了.........
怎么这么好混?我是这个月才从网易(真破!除了成人聊天...)转会过来的.
20日左右才认真回答别人的问题.现在已经600多了,真好混.专家真容易当.哈哈...

Answer 13

to:wyo(欧亚大陆桥)
你竟然跟我争生意？？？to shawls(小山)　
我也送给你，呵呵！

Answer 14

请来自(欧亚大陆桥)的WYO和南海的unruledboy两位老专家上来领奖，这次颁奖大会主要是为了表彰他们对VB所作出的不少努力以及比较好“钻研”，两个人竟很巧合地同时造出了电子邮件发送程序源代码，更为巧合的是源代码几乎如出一辙，为本人解了一时之难（还未送佛到西天的哟），现特别给予精神与物质鼓励，奖金为每人100＋50分，希再接再励，更进一步......鼓掌声。。
现在，我宣布颁奖大会到此结束，请两位把奖金拿好了，小心小偷呀!二位走好........
@_@

Answer 15

to shawls(小山)　
我只要50分。呵呵，气死：wyo(欧亚大陆桥)　！！！

Answer 16

to:OLD_VB_FAN(蓝星)　
你这老狐狸，呵呵。我以后一定捧你的场！！！

Answer 17

to shawls(小山):
到俺这二道贩子这儿来看看货吧，保证不让你失望，50分，提供相应源码、文章、控件近20个，如何，先别晕...　

Answer 18

to:OLD_VB_FAN(蓝星)　
你这老狐狸!!!呵呵!

Answer 19

to  unruledboy(南海佬)
都是兄弟，争什么，我刚满月，你都老大不小了。要分吗？小弟给你就是。

Answer 20

to shawls(小山):请到http://jszb.jsagri.gov.cn/mailtool.zip下载你需要的东西，已经过金山毒霸检查，放心下载
Have fun!!!
@_@

Answer 21

to:wyo(欧亚大陆桥)
开玩笑而已。我今年22不到，还没老呢！