Public Answerf   As Boolean
Function SendMail(WSock As Winsock, sFrom As String, sTo As String, sTitle As String, sMsg As String) As Boolean
On Error GoTo 12
Dim CodeDoc   As String
Dim StrMessage   As String
'Dim  ca  As  New  C64
 
WSock.Connect
Waiting
'WSock.SendData "HELO  " & 发信人 & vbCrLf
WSock.SendData "EHLO  " & sFrom & vbCrLf
Waiting
 
 
WSock.SendData "AUTH  LOGIN" + vbCrLf
Waiting
WSock.SendData B64E("我的用户名") + vbCrLf
Waiting
WSock.SendData B64E("我的密码") + vbCrLf
Waiting
WSock.SendData "MAIL  FROM:<" + sFrom + ">" + vbCrLf
Waiting
WSock.SendData "RCPT  TO:<" + sTo + ">" + vbCrLf
Waiting
WSock.SendData "DATA  " + vbCrLf
Waiting
'WSock.SendData  "DATE:"  +  Format(Now,  "dd  mmm  yy  tttt")  +  vbCrLf
'WSock.SendData  "FROM:"  +  sFrom
'WSock.SendData  "TO:"  +  sTo
WSock.SendData "SUBJECT:" & sTitle & vbCrLf
 
'Exit  Function
WSock.SendData sMsg & vbLf
WSock.SendData "." & vbCrLf
Waiting
WSock.SendData "QUIT"
WSock.Close
SendMail = True
Exit Function
12
SendMail = False
End Function
Sub Waiting()
Dim PauseTime, Start
PauseTime = 30
Start = Timer
Do While Timer < Start + PauseTime And Not Answerf
'Do  While  Answerf
   DoEvents
Loop
Answerf = False
End Sub
Function MyAsc(OneChar)
If OneChar = "" Then MyAsc = 0 Else MyAsc = Asc(OneChar)
End Function
Function B64E(inData)
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim sOut, cOut, i
 
For i = 1 To Len(inData) Step 3
Dim nGroup   As Long
Dim pOut, sGroup
 
nGroup = &H10000 * Asc(Mid(inData, i, 1)) + &H100 * MyAsc(Mid(inData, i + 1, 1)) + MyAsc(Mid(inData, i + 2, 1))
sGroup = Oct(nGroup)
sGroup = String(8 - Len(sGroup), "0") + sGroup
 
pOut = Mid(Base64, CLng("&o" + Mid(sGroup, 1, 2)) + 1, 1) + Mid(Base64, CLng("&o" + Mid(sGroup, 3, 2)) + 1, 1) + Mid(Base64, CLng("&o" + Mid(sGroup, 5, 2)) + 1, 1) + Mid(Base64, CLng("&o" + Mid(sGroup, 7, 2)) + 1, 1)
'Mid(Base64,  CLng("&o"  +  Mid(sGroup,  7,  2))  +  1,  1)
'
'  Mid(Base64,  CLng("&o"  +  Mid(sGroup,  3,  2)),  1)
'
'+  Mid(Base64,  CLng("&o"  +  Mid(sGroup,  7,  2))  +  1,  1)  +  Mid(Base64,  CLng("&o"  +  Mid(sGroup,  7,  2))  +  1,  1)
sOut = sOut + pOut
If (i + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf
Next i
Select Case Len(inData) Mod 3
Case 1
sOut = Left(sOut, Len(sOut) - 2) + "=="
Case 2
sOut = Left(sOut, Len(sOut) - 1) + "="
End Select
B64E = sOut
End FunctionPrivate Sub Command1_Click()
Wsk.Close
Wsk.RemoteHost = "smtp.21cn.com"
Wsk.RemotePort = 25
Dim a   As Boolean
a = SendMail(Wsk, "发信人", "收信人", "标题", "内容")
Debug.Print a
End Sub