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

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

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

上一篇:pytorch框架下的线性回归小demo


下一篇:Linux基础知识——Linux磁盘管理