偶想做一个简单的邮件发送程序,(smtp.163.com)大虾们快快帮帮偶.............

解决方案 »

  1.   

    '程序组合:dapha(汪锋)
    '下载http://www.dapha.net
    '我是一名VB爱好者,希望得到大家的帮助,共同学习,进步
    '转摘请保留以上信息,谢谢合作
    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 Enum
    Private m_State As SMTP_State
    Private m_strEncodedFiles As String
    Private 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 Function
    Private Sub cmdExit_Click()
    Unload Me
    End Sub
    Private Sub CmdSend_Click()
        Winsock1.Close
        Winsock1.LocalPort = 0
        strserver = txtserver
        ColonPos = InStr(strserver, ":")
        If ColonPos = 0 Then
            Winsock1.Connect strserver, 25
        Else
            lngPort = CLng(Right$(strserver, Len(strserver) - ColonPos))
            strserver = Left$(strserver, ColonPos - 1)
            Winsock1.Connect strserver, lngPort
        End If
        m_State = MAIL_CONNECT    '
        StatusTxt = "试图与服务器连接"
    End SubPrivate Sub Form_Load()End SubPrivate Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
        Dim strServerResponse   As String
        Dim strResponseCode     As String
        Dim strDataToSend       As String    '
        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
        strime1 = "Subject:" + Chr(32) + subject + vbCrLf ' Subject of E-Mail
        strime = txtMessage + vbCrLf ' E-mail message body
        strime2 = "X-Mailer:影子:邮件发送软件V1.0" + vbCrLf ' What program sent the e-mail, customize this
        'MULTI-PART Edit
        strime = "------=_NextPart_" + Globalstr + vbCrLf + "Content-type: text/plain; charset=gb2312" + vbCrLf + vbCrLf + strime
    '    strime = strime + "------=_NextPart_" + Globalstr + vbCrLf + "Content-type: text/HTML" + vbCrLf + vbCrLf
    '    strime = strime + "------=_NextPart_" + Globalstr + "--" + vbCrLf
        strime1 = strime1 + "MIME-Version: 1.0" + vbCrLf + "Content-Type: multipart/alternative; " + vbCrLf + Chr(9) + "boundary=""----=_NextPart_" + Globalstr + """" + vbCrLf + vbCrLf + "This mail is In MIME format. Your mail interface does Not appear To support this format." + vbCrLf + vbCrLf
        strimeall = strime2 + strime1
        Winsock1.GetData strServerResponse
        strResponseCode = Left(strServerResponse, 3)
        If strResponseCode = "250" Or _
           strResponseCode = "220" Or _
           strResponseCode = "354" Or _
           strResponseCode = "334" Or _
           strResponseCode = "235" Then
            Select Case m_State
                Case MAIL_CONNECT
                    m_State = MAIL_HELO
                    strDataToSend = Trim$(txtfrom)
                    'strDataToSend = Left$(strDataToSend, _
                                    InStr(1, strDataToSend, "@") - 1)
                     Winsock1.SendData "HELO " & strDataToSend & vbCrLf
                     StatusTxt = "登陆服务器"
                Case MAIL_HELO
                     m_State = MAIL_USER
                     Winsock1.SendData "AUTH LOGIN" & vbCrLf
                     StatusTxt = "正在校验用户名"
                Case MAIL_USER
                     m_State = MAIL_PASS
                     Winsock1.SendData (Base64_Encode(Trim(user.Text))) & vbCrLf
                     StatusTxt = "校验用户密码"
                Case MAIL_PASS
                     m_State = mail_login
                     Winsock1.SendData (Base64_Encode(txtpwa)) & vbCrLf
                     StatusTxt = "发送人邮件地址"
                Case mail_login
                     m_State = MAIL_from
                     Winsock1.SendData "MAIL FROM:" & Trim$(txtfrom) & vbCrLf
                     StatusTxt = "接收人邮件地址"
                Case MAIL_from
                     m_State = MAIL_RCPTTO
                     Winsock1.SendData "RCPT TO:" & Trim$(getaddress) & vbCrLf
                     StatusTxt = "邮件发送之中..."
                Case MAIL_RCPTTO
                     m_State = MAIL_DATA
                     Winsock1.SendData "DATA" & vbCrLf
                     StatusTxt = "获取邮件内容"
                Case MAIL_DATA
                    m_State = MAIL_DOT
                    Winsock1.SendData "From:" & user.Text & " <" & txtfrom & ">" & vbCrLf
                    Winsock1.SendData "To:" & toname & " <" & getaddress & ">" & vbCrLf
                    Winsock1.SendData strimeall & vbCrLf
                    
                    Winsock1.SendData strime & vbCrLf
                    Winsock1.SendData "." & vbCrLf
                    StatusTxt = "邮件送完毕"
                Case MAIL_DOT
                    m_State = MAIL_QUIT
                    Winsock1.SendData "QUIT" & vbCrLf
                    StatusTxt = "邮件成功发送!!!"
                  Case MAIL_QUIT
                     Winsock1.Close
                     StatusTxt = "待命之中..."
             End Select
        Else
             Winsock1.Close
        End If
    Debug.Print strServerResponse
    End Sub
      

  2.   

    txtfrom 文本 发送人地址
    getaddress文本 收地址
    txtserver文本 smtp服务器
    subject文本 主题
    user文本 用户名txtpwa文本 密码
    txtMessage文本 邮件内容
    StatusTxt lable 当前状态
    Winsock1 Winsock控件 
      

  3.   

    http://www.smartmaildemo.com上有免费代码下载!
      

  4.   

    在 用 'base6加密算法时怎么把哪个加密的文件越加越大呀
      

  5.   

    http://community.csdn.net/Expert/topic/4004/4004248.xml?temp=.1748163