[系统运维]VFB直接使用TCP发送电子邮件源码

电子邮件发送，就是用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

代码比较粗制滥造，而且带中文代码，不要见笑。有用就自己改造吧。

带中文代码比较好阅读，呵呵。