电子邮件发送,就是用TCP发的,用的是 SMTP协议,其实就是服务器一句话,客户端一句话,这样相互说几句,就发邮件了,具体代码如下:
直接拷贝就可以使用,还可以自己轻松改造和打包。
#Include Once "win/winsock2.bi"
Print 发邮件("370037607@qq.com","勇芳软件","验证码:9999")
Function 发邮件(接收方邮件地址 As String ,主题 As String ,内容 As String) As String
'建立一个TCP通道 --------------
Dim socketId As SOCKET = socket_(AF_INET ,SOCK_STREAM ,IPPROTO_TCP)
If socketId = SOCKET_ERROR Then
Return "错误,TCP通道"
End If
Dim Url As String = "smtp.qq.com" '邮件服务器
Dim Port As UShort = 25 '邮件服务器端口
Dim 账号 As String = "你自己的QQ号@qq.com" '发送邮件的账号
Dim 密码 As String = "QQ号邮箱密码" '发送邮件的密码
' 连接目标服务器 ------------------
Dim serverAddr As SOCKADDR_IN
serverAddr.sin_family = AF_INET
serverAddr.sin_port = htons(Port)
serverAddr.sin_addr.s_addr = UrltoIPnumeric(Url)
Dim iResult As Integer = connect(socketId ,CPtr(SOCKADDR Ptr ,@serverAddr) ,SizeOf(serverAddr))
If (iResult < 0) Then closesocket(socketId) : Return "错误,连接不到目标服务器"
Dim rr As String
rr = 电子邮件获取数据(socketId) : If Left(rr ,4) <> "220 " Then closesocket(socketId) : Return "错误,目标不是邮件服务器"
电子邮件发送数据(socketId ,"ehlo " & 账号 & vbCrLf)
rr = 电子邮件获取数据(socketId) : If Left(rr ,4) <> "250-" Then closesocket(socketId) : Return "错误,用户名错误"
电子邮件发送数据(socketId ,"auth login" & vbCrLf)
rr = 电子邮件获取数据(socketId) : If Left(rr ,4) <> "334 " Then closesocket(socketId) : Return "错误,登录不支持"
电子邮件发送数据(socketId ,Base64_Encode(账号) & vbCrLf)
rr = 电子邮件获取数据(socketId) : If Left(rr ,4) <> "334 " Then closesocket(socketId) : Return "错误,账号无效"
电子邮件发送数据(socketId ,Base64_Encode(密码) & vbCrLf)
rr = 电子邮件获取数据(socketId) : If Left(rr ,4) <> "235 " Then closesocket(socketId) : Return "错误,账号或密码不正确"
电子邮件发送数据(socketId ,"mail from:<" & 账号 & ">" & vbCrLf)
rr = 电子邮件获取数据(socketId) : If Left(rr ,4) <> "250 " Then closesocket(socketId) : Return "错误,发件人邮件不对"
电子邮件发送数据(socketId ,"rcpt to:<" & 接收方邮件地址 & ">" & vbCrLf)
rr = 电子邮件获取数据(socketId) : If Left(rr ,4) <> "250 " Then closesocket(socketId) : Return "错误,接收人邮件不对"
电子邮件发送数据(socketId ,"data" & vbCrLf)
rr = 电子邮件获取数据(socketId) : If Left(rr ,4) <> "354 " Then closesocket(socketId) : Return "错误,邮件格式不支持"
电子邮件发送数据(socketId , _
"from:<" & 账号 & ">" & vbCrLf & _
"to:<" & 接收方邮件地址 & ">" & vbCrLf & _
"subject:" & 主题 & vbCrLf & vbCrLf & 内容 & vbCrLf & "." & vbCrLf)
rr = 电子邮件获取数据(socketId) : If Left(rr ,4) <> "250 " Then closesocket(socketId) : Return "错误,无法发送邮件"
电子邮件发送数据(socketId ,"quit" & vbCrLf)
rr = 电子邮件获取数据(socketId) : If Left(rr ,4) <> "221 " Then closesocket(socketId) : Return "错误,关闭邮件服务"
closesocket(socketId)
Function = "成功"
End Function
Function 电子邮件发送数据(socketId As SOCKET,nData As String ) As Long
'给服务器发送数据 ----------------
If Len(nData) = 0 Then nData = " " '不可以空数据,不然就卡死
Dim czit As Long = Len(nData)
Dim rez As Long ,iResult As Long
'可能数据太大,一次发不完,需要很多次发 ------------
'Print "发送:",nData
Do
rez = send(socketId ,StrPtr(nData) + iResult ,czit ,0)
If (rez = SOCKET_ERROR) Then
Dim we As Long = WSAGetLastError()
If we = 10054 Then '客户已经断开
closesocket(socketId)
Return 0
Else
closesocket(socketId)
Return 0
End If
Exit Do
ElseIf rez = 0 Then
Exit Do
ElseIf rez < czit Then '表示还没发送完成,继续发
iResult += rez
czit -= rez
Else
iResult += rez
Exit Do
End If
Loop
Function =1
End Function
Function 电子邮件获取数据(socketId As SOCKET) As String
'获取服务器返回数据 ----------------
Dim buf As String = String(4099 ,0)
Dim nlen As Integer
Dim re As String
nlen = recv(socketId ,Str(buf) ,4096 ,0)
If (nlen = 0) Or (nlen = SOCKET_ERROR) Then
'Exit Do
Else
re &= Left(buf ,nlen)
End If
'Print "接收:" ,re
Function = re
End Function
Function UrltoIPnumeric(Url As String) As ULong '将网址或IP字符,转为 数字IP值,失败返回 0(就是IP无效或网址无效)
Dim p As Integer = InStr(Url ,"://")
Dim hostname As String = IIf(p = 0 ,Trim(Url) ,Trim(Mid(Url ,p + 3)))
p = InStr(hostname ,Any "/\:")
If p Then hostname = Left(hostname ,p -1)
Dim ia As IN_ADDR
Dim hostentry As hostent Ptr
Dim ip As Integer
'' 检查它是否是一个IP地址
ia.s_addr = inet_addr(hostname)
If (ia.s_addr = INADDR_NONE) Then
'' 如果没有,假设它是一个名字,解决它
hostentry = gethostbyname(hostname)
If (hostentry = 0) Then Return 0
Function = *Cast(Integer Ptr , *hostentry->h_addr_list)
Else
'' 只是返回地址
Function = ia.s_addr
End If
End Function
代码比较粗制滥造,而且带中文代码,不要见笑。有用就自己改造吧。
带中文代码比较好阅读,呵呵。