VB发邮件 为什么键盘密探2.0 不能发邮件

可能你网术有问题

键盘密探2.0 是自己写的VB程序吗？

发邮件参考下面的修改功能吧。这个模块能实现无附件的邮件发送

Option Explicit

Public Response As String

Dim First As String, Second As String, Third As String Dim Fourth As String, Fifth As String, Sixth As String Dim Seventh As String, Eighth As String, Ninth As String Dim Start As Single, Tmr As Single, DateNow As String

'要使用本模块必须添加 Winsock 控件,并且添加如下代码 'Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) ' Winsock1.GetData Response 'End Sub Dim tmpWinsock As Winsock Dim conTimeOut As Long

'发邮件需要你有有SMTP功能的邮件服务器帐号 Const UserName = "" '用户名，使用BASE64编码 Const Password = "" '密码，使用BASE64编码 Public Const conFromEmailAddress = ""

Public Function SendEmail(ctlWinsock As Winsock, MailServerName As String, FromName As String, FromEmailAddress As String, ToName As String, ToEmailAddress As String, EmailSubject As String, EmailBodyOfMessage As String, Optional ResponsesEmail As String, Optional Timeout As Long = 30) As Boolean 'ctlWinsock Winsock控件 'MailServerName SMTP邮件服务器 'FromName 发送人的姓名 'FromEmailAddress 发送的EMail地址 'ToName 发送到的姓名 'ToEmailAddress 发送到的EMail地址 'EmailSubject 主题 'EmailBodyOfMessage 内容,注意邮件发送是以<CR><LF>.<CR><LF>结束，可能需要将内容中的.<CR><LF>替换掉 'ResponsesEmail 如果需要回复到非发送EMail,请在此指明 If Len(ResponsesEmail) = 0 Then ResponsesEmail = FromEmailAddress conTimeOut = Timeout Set tmpWinsock = ctlWinsock If tmpWinsock.State = sckClosed Then tmpWinsock.LocalPort = 0 DateNow = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") & "" & " -0600" First = "mail from: " + "<" + FromEmailAddress + ">" + vbCrLf Second = "rcpt to: " + "<" + ToEmailAddress + ">" + vbCrLf Third = "Date: " + DateNow + vbCrLf ' Date when being sent Fourth = "From: " + FromName + "<" + ResponsesEmail + ">" + vbCrLf Fifth = "To: " + ToName + "<" + ToEmailAddress + ">" + vbCrLf Sixth = "Subject: " + EmailSubject + vbCrLf Seventh = Replace(EmailBodyOfMessage, "." + vbCrLf, vbCrLf) + vbCrLf Ninth = "X-Mailer: AnilSoft v 1.0" + vbCrLf Eighth = Fourth + Third + Ninth + Fifth + Sixth tmpWinsock.Protocol = sckTCPProtocol tmpWinsock.RemoteHost = MailServerName tmpWinsock.RemotePort = 25 Debug.Print "Send: Connect" + vbCrLf tmpWinsock.Connect ' Start connection If WaitFor("220") = False Then GoTo closeSock Debug.Print "Send: HELO" + vbCrLf tmpWinsock.SendData ("HELO cmechina" + vbCrLf) If WaitFor("250") = False Then GoTo closeSock Debug.Print "Send: 使服务器可以表明自己支持扩展简单邮件传输协议 (ESMTP) 命令。" + vbCrLf tmpWinsock.SendData ("ehlo " + vbCrLf) If WaitFor("250") = False Then GoTo closeSock tmpWinsock.SendData ("auth login " + vbCrLf) If WaitFor("334") = False Then GoTo closeSock Debug.Print "Send: 用户名" + vbCrLf tmpWinsock.SendData (UserName + vbCrLf) If WaitFor("334") = False Then GoTo closeSock Debug.Print "Send: 密码" + vbCrLf tmpWinsock.SendData (Password + vbCrLf) If WaitFor("235") = False Then GoTo closeSock Debug.Print "Send: " + First + vbCrLf tmpWinsock.SendData (First) If WaitFor("250") = False Then GoTo closeSock Debug.Print "Send: " + Second + vbCrLf tmpWinsock.SendData (Second) If WaitFor("250") = False Then GoTo closeSock Debug.Print "Send: data" + vbCrLf tmpWinsock.SendData ("data" + vbCrLf) If WaitFor("354") = False Then GoTo closeSock Debug.Print "Send: 正在发送邮件内容" + vbCrLf tmpWinsock.SendData (Eighth + vbCrLf) tmpWinsock.SendData (Seventh + vbCrLf) tmpWinsock.SendData ("." + vbCrLf) If WaitFor("250") = False Then GoTo closeSock Debug.Print "Send: quit" + vbCrLf tmpWinsock.SendData ("quit" + vbCrLf) If WaitFor("221") = False Then GoTo closeSock tmpWinsock.Close SendEmail = True Exit Function closeSock: Debug.Print "出错关闭" + vbCrLf tmpWinsock.Close SendEmail = False Else Debug.Print "Winsock.State = " + Str(tmpWinsock.State) End If End Function

Function WaitFor(ResponseCode As String) As Boolean Start = Timer ' Time event so won't get stuck in loop While Len(Response) = 0 Tmr = Timer - Start DoEvents ' Let System keep checking for incoming response **IMPORTANT** If Tmr > conTimeOut Then ' Time in seconds to wait Debug.Print "SMTP service error, timed out while waiting for response" WaitFor = False Exit Function End If Wend While Left(Response, 3) <> ResponseCode DoEvents If tmp = "421" Or tmp = "500" Or tmp = "502" Or tmp = "535" Then Debug.Print Response WaitFor = False Exit Function End If Tmr = Timer - Start If Tmr > conTimeOut Then Debug.Print "SMTP service error, impromper response code. Code should have been: " + ResponseCode + vbCrLf + " Code recieved: " + Response WaitFor = False Exit Function End If Wend Debug.Print "成功完成" + vbCrLf Response = "" WaitFor = True End Function