VB中一个“砍信程序”的VB源代码

　　 
　　对于邮箱里的邮件来说，如果你不想去收取它，则可以直接把它删除！而不用去查看。以下是一个vb程序的“删除邮件”的源代码！！它是利用pop3协议来弄的！各位如果不明白程序的代码可以先去查看一下pop3协议的原理！！！
：

源代码如下：

dim flag as integer, letters as integer, nowletter as integer
private sub command1_click()
if hostname.text = "" then
hostname.setfocus
exit sub
end if
if username.text = "" then
username.setfocus
exit sub
end if
if userpass.text = "" then
userpass.setfocus
exit sub
end if
mail.remotehost = hostname.text
mail.remoteport = 110
mail.connect
flag = 1
letters = 0
infowindow.seltext = vbnewline + "正在和服务器" + mail.remotehost + "连接……"
end sub

private sub command2_click()
if val(label5.caption) > 1 then
if msgbox("是否真的要删除前面的邮件？", vbquestion + vbyesno, "提示") = vbyes then
 mail.senddata "quit " + vbcrlf
 timer1.enabled = true
else
 mail.senddata "rset" + vbcrlf + "quit" + vbcrlf
 timer1.enabled = true
end if
end if
end sub

private sub form_load()
infowindow.seltext = "+----------------------------------------------+" + vbnewline
infowindow.seltext = "+ 程序制作：影 子      制作日期：2003年3月19日 +"
infowindow.seltext = vbnewline + "+----------------------------------------------+"
end sub

private sub infowindow_click()
infowindow.selstart = len(infowindow.text)
end sub

private sub mail_connect()
command1.enabled = false
command2.enabled = true
end sub

private sub mail_dataarrival(byval bytestotal as long)
dim sdata as string
mail.getdata sdata
getcmd sdata
end sub

private sub getcmd(cmdtext as string)
on error goto e:
dim cmd as string
cmd = left(cmdtext, 3)
select case ucase(cmd)
case "+ok"
   select case flag
     case 1           '刚和服务器连接成功
       mail.senddata "user " + username.text + vbcrlf
       infowindow.seltext = vbnewline + "服务器正在验证用户名……"
       flag = 2
     case 2
       infowindow.seltext = vbnewline + "服务器正在验证用户密码……"
       mail.senddata "pass " + userpass.text + vbcrlf
       flag = 3
     case 3
       infowindow.seltext = vbnewline + "正在获取用户拥有的邮件数……"
       mail.senddata "stat" + vbcrlf
       flag = 4
     case 4
       for i = 5 to len(cmdtext)
        if mid(cmdtext, i, 1) = " " then
          label5.caption = trim(mid(cmdtext, 5, i - 5))
          letters = val(label5.caption)
          exit for
        end if
       next
        if letters = 0 then              '没有信件则退出
         mail.senddata "quit" + vbcrlf
         timer1.enabled = true
         infowindow.seltext = vbnewline + "邮箱里没有邮件可删除！正在和服务器断开连接……"
         exit sub
        end if
        nowletter = 1
        label6.caption = cstr(nowletter)
        mail.senddata "dele 1" + vbcrlf
        flag = 5
        infowindow.seltext = vbnewline + "获取邮件数成功！正在删除第1封邮件……"
      case 5
        if nowletter >= letters then
         mail.senddata "quit" + vbcrlf
         timer1.enabled = true
         infowindow.seltext = vbnewline + "全部邮件删除成功！正在和服务器断开连接……"
         exit sub
        end if
        nowletter = nowletter + 1
        label6.caption = cstr(nowletter)
        mail.senddata "dele " & nowletter & vbcrlf
        if nowletter = 2 then
           infowindow.seltext = vbnewline + "第1封邮件删除成功！正在删除第2封邮件……"
        else
           infowindow.seltext = vbnewline + "第" + cstr(nowletter - 1) + "封邮件删除成功！正在删除第" & nowletter & "封邮件……"
        end if
     end select
 case "-er"
    select case flag
     case 2
        username.setfocus
        mail.senddata "quit" + vbcrlf
        timer1.enabled = true
        infowindow.seltext = vbnewline + "用户名不能通过服务器的验证！！"
     case 3
        userpass.setfocus
        mail.senddata "quit" + vbcrlf
        timer1.enabled = true
        infowindow.seltext = vbnewline + "用户密码不能通过服务器的验证！！"
     end select
 end select
exit sub
e:
infowindow.text = ""
end sub

private sub mail_error(byval number as integer, description as string, byval scode as long, byval source as string, byval helpfile as string, byval helpcontext as long, canceldisplay as boolean)
mail.close
infowindow.seltext = vbnewline + "发生未知错误！！请检查网络！！！"
end sub

private sub timer1_timer()
mail.close
command2.enabled = false
command1.enabled = true
timer1.enabled = false
end sub

原文转自：http://www.ltesting.net