用VB写SMTP客户端

本想在网上找一段现成的用，找了半天没找到，只得自己慢慢搞

其实这东西跟VB没啥关系，只是SMTP协议的实现

写的很乱，但是能发出去，本着能用就行的原则，到此结束。。。

需要一个模块，主要是一个加密算法：

Public UserName As String
Public MailPass As String
Public EmailFromAdd As String
Public MailToAdd As String
Public MailSub As String
Public MailMessage As String

Function Base64Encode(inData)
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim cOut, sOut, i
For i = 1 To Len(inData) Step 3
Dim nGroup, pOut, sGroup
nGroup = &H10000 * Asc(Mid(inData, i, 1)) + _
&H100 * MyASC(Mid(inData, i + 1, 1)) + MyASC(Mid(inData, i + 2, 1))
nGroup = Oct(nGroup)
nGroup = String(8 - Len(nGroup), "0") & nGroup
pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)
sOut = sOut + pOut
Next
Select Case Len(inData) Mod 3
Case 1:
sOut = Left(sOut, Len(sOut) - 2) + "=="
Case 2:
sOut = Left(sOut, Len(sOut) - 1) + "="
End Select
Base64Encode = sOut
End Function
Function MyASC(OneChar)
If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
End Function

之后就是发送邮件的，其中的ws是winsock ocx：

Public Sub SendMail()
UserName = “用户名”
MailPass = “邮箱密码”
EmailFromAdd = "123@163.com"
MailToAdd = “456@qq.com”
MailSub = "邮件主题"
MailMessage = “邮件内容”
ws.Protocol = sckTCPProtocol
ws.RemoteHost = "smtp.163.com"
ws.RemotePort = 25
ws.Connect
End Sub

Private Sub ws_DataArrival as String(ByVal bytesTotal As Long)
Dim DataIn As String
Dim DealStr As String
ws.GetData DataIn
DealStr = Left(DataIn, 3)
Select Case DealStr
Case Is = "220"
ws.SendData "helo " & Username + vbCrLf
Case Is = "250"
If Mid(DataIn, 5, 2) = "OK" Then
ws.SendData "auth login" + vbCrLf
'ws.Close
End If
If Mid(DataIn, 5, 4) = "Mail" Then
ws.SendData "rcpt to:<" & EmailFromAdd & ">" + vbCrLf
ws.SendData "DATA" + vbCrLf
End If
Case Is = "334"
If Mid(DataIn, 5, 3) = "dXN" Then ws.SendData Base64Encode(Trim(Username)) + vbCrLf
If Mid(DataIn, 5, 3) = "UGF" Then ws.SendData Base64Encode(Trim(MailPass)) + vbCrLf
Case Is = "235"
ws.SendData "mail from:<" & EmailFromAdd & ">" + vbCrLf
Case Is = "354"
ws.SendData "to:" & MailToAdd + vbCrLf
ws.SendData "from:" & EmailFromAdd + vbCrLf
ws.SendData "subject:" & MailSub + vbCrLf
ws.SendData MailMessage + vbCrLf
ws.SendData "." + vbCrLf
End Select
End Sub