电子邮件发送,就是用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
代码比较粗制滥造,而且带中文代码,不要见笑。有用就自己改造吧。
带中文代码比较好阅读,呵呵。