200分求教高手帮助修改邮件发送程序，谢谢！！！

200分求教高手帮助修改邮件发送程序，谢谢！！！以下代码能发送简单邮件（不能发送大的邮件，即hh.txt文件不能太大（200k以上）），求教高手帮助修改一下程序，已能发送大的邮件（原则上不限制邮件大小（几十到一百兆）都可，谢谢！！！
来信，我可将程序发送给您
[email protected]:
Label1.Caption  ; 发件人    对应 ; text4
Label2.Caption  ; 收件人    对应 ; text1
Label5.Caption  ; SMTP      对应 ; text5
Label3.Caption  ; 用户名    对应 ; text2
Label4.Caption  ; 密码      对应 ; text3
Command1.Caption；发送邮件
FORM2:
FORM2.Caption 发送邮件
Label1.Caption  ; StatusTxt代码：
FORM1:
Private Sub Command1_Click()
Load 发送邮件
End Sub
FORM2: 
Private Enum SMTP_State
    MAIL_CONNECT
    MAIL_HELO
    MAIL_from
    MAIL_RCPTTO
    MAIL_DATA
    MAIL_DOT
    MAIL_QUIT
    MAIL_USER
    MAIL_PASS
    mail_login
End EnumPrivate m_State As SMTP_StatePrivate Sub Form_Load()
Me.Show
FailDatum
End SubPrivate Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim strServerResponse   As String
    Dim xjnr
    Dim llen As Long
    Dim mbyte() As Byte
    Dim strResponseCode     As String
    Dim strDataToSend()     As String   '
    Dim strDataToSendend    As Long
    Const RandString As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890_"
    Dim Globalstr As String
    For jd = 1 To 24
        uniquey = Int(Rnd * Len(RandString)) + 1
        Globalstr = Globalstr + Mid(RandString, uniquey, 1)
    Next jd
        Select Case m_State
            Case MAIL_CONNECT
                m_State = MAIL_HELO
                Winsock1.SendData "HELO " & Form1.Text4 & vbCrLf
                 StatusTxt = "登陆服务器"
                  Winsock1.GetData strServerResponse
                If Left(strServerResponse, 3) <> "220" Then
                Winsock1.Close
                Unload Me
                MsgBox "无法登陆服务器"
                End If
                
            Case MAIL_HELO
                 m_State = MAIL_USER
                 Winsock1.SendData "AUTH LOGIN" & vbCrLf
                 StatusTxt = "正在校验用户名"
                  Winsock1.GetData strServerResponse
                 If Left(strServerResponse, 3) <> "250" Then
                Winsock1.Close
                Unload Me
                MsgBox "无法打开邮件发送对话"
                End If
                 
            Case MAIL_USER
                 m_State = MAIL_PASS
                 Winsock1.SendData (Base64_Encode(Form1.Text2)) & vbCrLf
                 StatusTxt = "校验用户密码"
                  Winsock1.GetData strServerResponse
            Case MAIL_PASS
                 m_State = mail_login
                 Winsock1.SendData (Base64_Encode(Form1.Text3)) & vbCrLf
                 StatusTxt = "发送人邮件地址"
                  Winsock1.GetData strServerResponse
            Case mail_login
                  Winsock1.GetData strServerResponse
                  m_State = MAIL_from
                  Winsock1.SendData "MAIL FROM:" & Trim$(Form1.Text4) & vbCrLf
                 StatusTxt = "接收人邮件地址"
            Case MAIL_from
                 m_State = MAIL_RCPTTO
                 Winsock1.SendData "RCPT TO:" & Trim$(Form1.Text1) & vbCrLf
                 StatusTxt = "邮件发送之中..."
                 Winsock1.GetData strServerResponse
            Case MAIL_RCPTTO
                 m_State = MAIL_DATA
                 Winsock1.SendData "DATA" & vbCrLf
                 StatusTxt = "获取邮件内容"
                 Winsock1.GetData strServerResponse
            Case MAIL_DATA
                m_State = MAIL_DOT
                Winsock1.SendData "From:" & " <" & Form1.Text4 & ">" & vbCrLf
                Winsock1.SendData "To:" & " <" & Form1.Text1 & ">" & vbCrLf
                llen = FileLen(App.Path + "\hh1.txt")
                
              ReDim mbyte(llen - 1)
                Open App.Path & "\hh1.txt" For Binary Access Read As #1
                 Get #1, , mbyte
                xjnr = StrConv(mbyte, vbUnicode)
                strContent = xjnr
                 Close #1
               strDataToSend = Split(strContent, vbCrLf)
             strDataToSendend = UBound(strDataToSend)
             For i = 0 To strDataToSendend
             Winsock1.SendData strDataToSend(i) & vbCrLf
             Next i
             Winsock1.SendData "." & vbCrLf
             StatusTxt = "邮件送完毕"
             Winsock1.GetData strServerResponse
              
            Case MAIL_DOT
                m_State = MAIL_QUIT
                Winsock1.SendData "QUIT" & vbCrLf
            Case MAIL_QUIT
               Winsock1.Close
                             
               Unload Form1
               Unload Me
              End Select
              Debug.Print strServerResponse
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)
Winsock1.Close
MsgBox "出现错误,请您检查网络连接或网络设置!!!"
   DoEvents
End SubPrivate Function Base64_Encode(strSource) As String 'base6加密算法
    Const BASE64_TABLE As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
    Dim strTempLine As String
    Dim j As Integer
    For j = 1 To (Len(strSource) - Len(strSource) Mod 3) Step 3
        strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) \ 4) + 1, 1)
        strTempLine = strTempLine + Mid(BASE64_TABLE, ((Asc(Mid(strSource, j, 1)) Mod 4) * 16 _
                      + Asc(Mid(strSource, j + 1, 1)) \ 16) + 1, 1)
        strTempLine = strTempLine + Mid(BASE64_TABLE, ((Asc(Mid(strSource, j + 1, 1)) Mod 16) * 4 _
                      + Asc(Mid(strSource, j + 2, 1)) \ 64) + 1, 1)
        strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j + 2, 1)) Mod 64) + 1, 1)
    Next j
    If Not (Len(strSource) Mod 3) = 0 Then
         If (Len(strSource) Mod 3) = 2 Then
            strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) \ 4) + 1, 1)
            strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) Mod 4) * 16 _
                      + Asc(Mid(strSource, j + 1, 1)) \ 16 + 1, 1)
             strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j + 1, 1)) Mod 16) * 4 + 1, 1)
            strTempLine = strTempLine & "="
        ElseIf (Len(strSource) Mod 3) = 1 Then
            strTempLine = strTempLine + Mid(BASE64_TABLE, Asc(Mid(strSource, j, 1)) \ 4 + 1, 1)
            strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, j, 1)) Mod 4) * 16 + 1, 1)
             strTempLine = strTempLine & "=="
        End If
     End If
    Base64_Encode = strTempLine
End FunctionSub FailDatum()
Dim SMTPPortport As Integer
Winsock1.Close
Winsock1.LocalPort = 0
strserver = Form1.Text5
SMTPPortport = "25"
   Winsock1.Connect strserver, SMTPPortport
   m_State = MAIL_CONNECT    '
End Sub

解决方案 »

  1.   

    'base6加密算法......这个代码如果发EXE或者图片之类的文件就会损坏
      

  2.   

    to: xiaohuangtao(绿毛网虫)
     请高手帮助看看，谢谢！！！！
      

  3.   

    to  usaspy(行走的鱼) ;谢谢您，谢谢！！！
    发邮件时，已接收到354 Start mail input; end with <CRLF>.<CRLF>，发邮件内容时为何会出现“错误40006，所请求的事务或请求本身的错误协议或者错误连接状态“
    或错误：“错误10053“请您予以帮助，谢谢！！！
      

  4.   

    >its screenshot url: 
    >http://free.efile.com.cn/huangtao/ScreenShot.jpg 
    >
    >setup download url: 
    >http://free.efile.com.cn/huangtao/SmartmailSource.rar 兄弟,没必要写!没有多大钱途,我都免费