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
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
有没有判断Winsock的连接状态? 如果不是7(Connected)就不能使用SendData方法.
怎么判断WINSOCK的连接状态啊?请指教