当前位置:编程学习 > VB >>

紧急!!!一个VB6编写的邮件接收程序,总是运行报错,请高手帮忙解决!!

前天在网上找的一个邮件接收程序,总是运行不下去,主要代码如下:
Private Enum smtpStates
      smtp_Connect
      smtp_USER
      smtp_PASS
      smtp_STAT
      smtp_RETR
      smtp_DELE
      smtp_QUIT
  End Enum
  Private m_State As smtpStates
  Private m_oMessage  As CMessage
  Private m_colMessages  As New CMessage
  Private oMes As CMessage
Private Sub cmdCheckMail_Click()
  '检查除txtBody之外所有文本框的内容是否为空
  For Each C In Controls
  If TypeOf C Is TextBox Then
      If Len(C.Text) = 0 Then
      MsgBox C.Name & "  can't   be   empty !", vbCritical
  Exit Sub
  End If
  End If
  Next
  '改变当前进程状态的值
  m_State = smtp_Connect
  '关闭socket以防它已被另一个进程打开。现在就让我来解释一下这个语句。当触发了cmdCheckMail_Click事件后,所运行的程序代码的目的是要连上远程邮件服务器。下面要进行的操作就转由在Winsock控件的DataArrival事件中的代码来控制了。
    '每次当Winsock收到数据时,都会触发DataArrival事件。根据已收到的数据和你所发出的命令,程序才知道应执行在该事件中的哪一部分代码,以真正完成数据的接收。
     '为了让程序记住你上次发出的命令,或者说当前进程的状态,我们使用了m_State变量。该变量存放你事先定义好的一个特殊的数据类型:smtpStates的值。
   Winsock1.Close
  '重置   local   port的值,Windows   Socket会自动寻找一个新值
  '这样做是为了防止出现   "地址正在被使用"的错误,
  '这种情况通常出现在Winsock控件已被前一个进程所使用
  Winsock1.LocalPort = 0
  'smtp服务器通常用端口110来等待连接请求
  '因此我们要让Winsock控件用这个端口连上服务器。
  Winsock1.Connect txtHost, 25
    End Sub
 Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim strData As String
Static intMessages As Integer     '要下载的消息数(也就是邮件数)
Static intCurrentMessage As Integer     '已下载的消息数
Static strBuffer As String     '正在下载的消息的缓冲
Dim wStr As String
Dim wStr1 As String
  '将收到的数据存放在strData变量中
  Winsock1.GetData strData
  Debug.Print strData
    
  If Left$(strData, 1) = "+" Or m_State = smtp_RETR Then
          '如果来自服务器的回应的第一个字符为加号
          '表明服务器已收到你发出的命令并等待下一个命令
          '如果服务器返回的字符串的第一个字符为减号,那我们在这里就什么也做不了。
          '操作被转到ELSE后面部分的代码。
          '当处于数据接收状态时,来自服务器的字符串的第一个字符就可能不是加号或减号,所以要用到第二个条件
          'm_State   =   smtp_RETR   (正在接收消息的状态)
     Select Case m_State
               Case smtp_Connect
                  '重置消息数
                  intMessages = 0
                  '改变进程状态
                  m_State = smtp_USER
                  '向服务器发出带参数的USER命令
                  '参数是信箱名
                  '别忘了在命令的最后加上vbCrLf
                  Winsock1.SendData "USER" & txtUserName & vbCrLf
                  '这是本次事件的结束,下次开始跳过上一部分,而从下面开始执行
                  '   Case   smtp_USER部分
                  Debug.Print "USER   " & txtUserName
                  
          Case smtp_USER
                    '如果用户名检查通过就进行下一部分
                     '现在向服务器发送你的密码
                   '改变进程的状态
                  m_State = smtp_PASS
                   '向服务器发送PASS命令,以你的密码为参数
                  Winsock1.SendData "PASS" & txtPassword & vbCrLf
                  Debug.Print "PASS   " & txtPassword
                  
          Case smtp_PASS
                '如果服务器通过了你的身份验证,我们就可以向服务器发送STAT命令了
                 '作为对STAT的回应,服务器会传回你邮箱中的消息数及大小
                 '改变当前进程的状态
                  m_State = smtp_STAT
                   '现在发送STAT命令
                  Winsock1.SendData "STAT" & vbCrLf
                  Debug.Print "STAT"
       
        Case smtp_STAT
                  '
                  '服务器对STAT的回应看上去象这样
                  '"+OK   0   0"   (邮箱中没有邮件)或   "+OK   3   7564"
                  '(邮箱中有邮件).显然,我们必须找到来自服务器返回的字符串中的第一个数字
               intMessages = CInt(Mid$(strData, 5, InStr(5, strData, "   ") - 5))
                  If intMessages > 0 Then
                         '如果邮箱中有邮件
                          '改变进程的状态
                          m_State = smtp_RETR
                          intCurrentMessage = intCurrentMessage + 1
                          '现在准备向服务器发送RETR命令
                          '以便接收第一条消息
                          Winsock1.SendData "RETR   1" & vbCrLf
                          Debug.Print "RETR   1"
                     Else
                          '如果邮箱中没有邮件就断开同服务器的连接结束进程
                           m_State = smtp_QUIT
                          Winsock1.SendData "QUIT" & vbCrLf
                          Debug.Print "QUIT"
                          MsgBox "You   have   not   mail.", vbInformation
                  End If
--------------------编程问答-------------------- 还有部分代码:
Case smtp_RETR
                  '在接收邮件时执行下面的代码
                  '邮件可能会很大,并触发多次DataArrival事件
                    '接收到的数据被存放在   strBuffer变量中
                  strBuffer = strBuffer & strData
                  '用下面的语句判断消息的结束
                  '邮件是以小数点结尾的
                      If InStr(1, strBuffer, vbLf & "." & vbCrLf) Then
                        '邮件下载完毕
                        '删除由服务器返回的第一行字符串
                          strBuffer = Mid$(strBuffer, InStr(1, strBuffer, vbCrLf) + 2)
                          '删除最后一个只有小数点的字符
                          strBuffer = Left$(strBuffer, Len(strBuffer) - 3)
                          '把消息存放在m_colMessages集合中
                          Set m_oMessage = New CMessage
                          m_oMessage.CreateFromText strBuffer
                          m_colMessages.Add m_oMessage, m_oMessage.MessageID
                          Set m_oMessage = Nothing
                           '清空缓冲,准备接收下一条邮件
                         strBuffer = ""
                          End If

                          '将已收的邮件数同服务器目前的邮件数作比较
                          If intCurrentMessage = intMessages Then
                                  '如果相等,表示已接收完所有的邮件
                                   '所以发送一个QUIT命令给服务器
                                  m_State = smtp_QUIT
                                  Winsock1.SendData "QUIT" & vbCrLf
                                  Debug.Print "QUIT"
                            Else
                                  '如果二者不等,表明还有邮件没有接收
                                   intCurrentMessage = intCurrentMessage + 1
                                     '改变当前进程的状态
                                  m_State = smtp_RETR
                                  '向服务器发出RETR命令接收下一个邮件
                    Winsock1.SendData "RETR   " & CStr(intCurrentMessage) & vbCrLf
                                  Debug.Print "RETR   " & intCurrentMessage
                         End If

                 Case smtp_QUIT
                    '不管我们收到什么样的邮件,记得关闭同服务器的连接
                    Winsock1.Close
                   '现在调用   ListMessages子程序,以便在ListView中显示收到的邮件
                    Call ListMessages
          End Select
  Else
          '下面的错误处理的代码
          '只须关闭socket并将来自服务器的回应显示出来就行了。
          '即使是那些高级的邮件接收程序所做也不外如此
          Winsock1.Close
          MsgBox "smtp   Error:   " & strData, vbExclamation, "smtp   Error"
  End If

   End Sub
 Private Sub Winsock1_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)

          MsgBox "Winsock   Error:   #" & Number & vbCrLf & Description
End Sub
Private Sub ListMessages()
          Dim oMes As CMessage
          Dim lvItem As ListItem
            
          For Each oMes In m_colMessages
                  Set lvItem = lvMessages.ListItems.Add
                  lvItem.Key = oMes.MessageID
                  lvItem.Text = oMes.From
                  lvItem.SubItems(1) = oMes.Subject
                  lvItem.SubItems(2) = oMes.SendDate
                  lvItem.SubItems(3) = oMes.Size
          Next
            
  End Sub
 CMessage类的定义没有写上去,主要的程序代码都在上面了,运行总是报错,我用的sina和sohu邮箱测试的,报错220smtp.sina.com.cn ESMTP SINAMAIL(Postfix Rules)就运行不下去了,我的目的主要是将邮箱邮件头信息能显示出来就行,请各位大侠帮忙,小女子感激不尽,问题解决就给分! --------------------编程问答-------------------- 请给出错误的信息和大概的代码位置 --------------------编程问答-------------------- 就是,太多了,不知道错在哪里 --------------------编程问答-------------------- 谢谢各位!上面的问题已经解决了,但是有个问题我还是不明白,我想将某个地址发过来的邮件删除,不知道怎么操作,我试着在Case smtp_RETR处加一段判断代码,但是总是将所有的邮件都清除了,这是为什么,添加代码如下:
           'For Each oMes1 In m_colMessages  '
               ' wStr = oMes1.From       
                'sjj = "select * from hmddzlb where hmddz='" & wStr & "' "
                                                    '打开数据集
                   'If sjj = "" Then
                      ' Call ListMessages
                     ' Exit For
                 ' Else
                    ' Set m_colMessages = Nothing
                      'Exit For
                  end if
添加在此代码后面 strBuffer = strBuffer & strData
               If InStr(1, strBuffer, vbLf & "." & vbCrLf) Then
                  strBuffer = Mid$(strBuffer, InStr(1, strBuffer, vbCrLf) + 2)
                  strBuffer = Left$(strBuffer, Len(strBuffer) - 3)
                  Set m_oMessage = New CMessage
                    m_oMessage.CreateFromText strBuffer
                   m_colMessages.Add m_oMessage, m_oMessage.MessageID
                   Set m_oMessage = Nothing
请各位高手帮忙解决!
--------------------编程问答-------------------- 帮你顶一下。 --------------------编程问答-------------------- 楼主,我也遇到你的同样问题(第一个),能不能告诉我你是如何解决的啊,万分感谢 --------------------编程问答-------------------- 偶也想知道..
cmessage类未定义 ,
Set m_oMessage = New CMessage
--------------------编程问答-------------------- 如何定义啊?Set m_oMessage = New CMessage
    Private   m_State   As   smtpStates 
    Private   m_oMessage     As   CMessage 
    Private   m_colMessages     As   New   CMessage 
    Private   oMes   As   CMessage  --------------------编程问答-------------------- 楼上这三个挖坟高手。。。。。。。。三四年前的帖子也挖。。。。。。
补充:VB ,  网络编程
CopyRight © 2012 站长网 编程知识问答 www.zzzyk.com All Rights Reserved
部份技术文章来自网络,