狠狠色丁香婷婷综合尤物/久久精品综合一区二区三区/中国有色金属学报/国产日韩欧美在线观看 - 国产一区二区三区四区五区tv

Option Explicit
Dim i&, Attachment&
Dim att         As Object
Dim EmailMsg         As Object
Dim atts        As Object
Dim JMail       As Object
Dim EmailList$, Subject$, EmailID&
Dim X$()
Private Sub Command1_Click()
    Dim J#
    Set JMail = CreateObject("JMail.POP3")
    JMail.Connect "***@163.com", "***", "pop.163.com", "110" 'JMail.Connect "郵箱名", "密碼", "服務(wù)器" [,"端口號(hào)"]
'    Debug.Print "你有" & JMail.Count & "封郵件"     '郵件數(shù)量
    For i = 1 To JMail.Count
'        EmailID = JMail.GetMessageUID(I)           '郵件唯一ID標(biāo)識(shí)
        Set EmailMsg = JMail.Messages.Item(i)       '取得一條郵件信息
'-----------------------------------------------------------------------------取得附件數(shù)量并下載
        Set atts = EmailMsg.Attachments             '附件集合
        Attachment = atts.Count                     '附件的數(shù)量
        If Attachment > 0 Then
            For J = 0 To Attachment - 1
                Set att = atts(J)
                If Dir(App.Path & "\" & att.Name) = "" Then 'att.Name附件的名稱，如果存在同名文件而不加判斷則會(huì)出錯(cuò)
                    att.SaveToFile App.Path & "\" & att.Name
                End If
            Next J
        End If
'------------------------------------------------------------------------------以下為各種參數(shù)設(shè)置
'        EmailMsg.Charset = "gb2312"                '編碼方式
'        EmailMsg.ContentTransferEncoding = "base64"'解碼方式
'        EmailMsg.Encoding = "base64"
'        EmailMsg.ContentType = "multipart/mixed"   '發(fā)送郵件時(shí)
'        EmailMsg.ContentType = "text/html"         '接收郵件時(shí)
'        EmailMsg.ISOEncodeHeaders = False'True     '功能不清？
'-----------------------------------------------------------------------------可以取得的各元素
'        MsgBox EmailMsg.Priority                   '郵件的優(yōu)先級(jí)，1-5，1最高，正常情況為3。
'        MsgBox EmailMsg.From                       '郵件的發(fā)送人的信箱地址
'        MsgBox EmailMsg.FromName                   '郵件的發(fā)送人
'        MsgBox EmailMsg.Date                       '郵件日期
'        MsgBox EmailMsg.Body                       '郵件內(nèi)容
'        MsgBox EmailMsg.Size                       '郵件大小
'----------------------------------------------------------------------------
        Subject = EmailMsg.Headers.GetHeader("Subject") '郵件標(biāo)題，可正常解碼，但UTF-8格式的標(biāo)題取不全
        X = Split(EmailMsg.Headers.GetHeader("Subject"), "?")
        If X(1) = "UTF-8" Then
            Subject = Utf8ToUnicode(StrToBytes(X(3)))
        Else
            Subject = Base64Decode(X(3))
        End If
'        Subject = EmailMsg.Headers.GetHeader("From")   '發(fā)件人，可解碼
'        Subject = EmailMsg.Headers.GetHeader("FromName")
        EmailList = EmailList & CStr(i) & "、" & Subject & vbCrLf
        DoEvents
    Next
    Text1.Text = EmailList
End Sub

Option Explicit
Public Const cstBase64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Public arrBase64() As String
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Private Const CP_ACP = 0        ' default to ANSI code page
Private Const CP_UTF8 = 65001   ' default to UTF-8 code page
Public Function Base64Encode(strSource As String) As String '編碼
   On Error Resume Next
   If UBound(arrBase64) = -1 Then
       arrBase64 = Split(StrConv(cstBase64, vbUnicode), vbNullChar)
   End If
   Dim arrB() As Byte, bTmp(2)  As Byte, bT As Byte
   Dim i As Long, J As Long
   arrB = StrConv(strSource, vbFromUnicode)
   
   J = UBound(arrB)
   For i = 0 To J Step 3
       Erase bTmp
       bTmp(0) = arrB(i + 0)
       bTmp(1) = arrB(i + 1)
       bTmp(2) = arrB(i + 2)
       
       bT = (bTmp(0) And 252) / 4
       Base64Encode = Base64Encode & arrBase64(bT)
       
       bT = (bTmp(0) And 3) * 16
       bT = bT + bTmp(1) \ 16
       Base64Encode = Base64Encode & arrBase64(bT)
       
       bT = (bTmp(1) And 15) * 4
       bT = bT + bTmp(2) \ 64
       If i + 1 <= J Then
           Base64Encode = Base64Encode & arrBase64(bT)
       Else
           Base64Encode = Base64Encode & "="
       End If
       
       bT = bTmp(2) And 63
       If i + 2 <= J Then
           Base64Encode = Base64Encode & arrBase64(bT)
       Else
           Base64Encode = Base64Encode & "="
       End If
   Next
End Function
Public Function Base64Decode(strEncoded As String) As String '解碼
   On Error Resume Next
   Dim arrB() As Byte, bTmp(3)  As Byte, bT As Long, bRet() As Byte
   Dim i As Long, J As Long
   arrB = StrConv(strEncoded, vbFromUnicode)
   J = InStr(strEncoded & "=", "=") - 2
   ReDim bRet(J - J \ 4 - 1)
   For i = 0 To J Step 4
       Erase bTmp
       bTmp(0) = (InStr(cstBase64, Chr(arrB(i))) - 1) And 63
       bTmp(1) = (InStr(cstBase64, Chr(arrB(i + 1))) - 1) And 63
       bTmp(2) = (InStr(cstBase64, Chr(arrB(i + 2))) - 1) And 63
       bTmp(3) = (InStr(cstBase64, Chr(arrB(i + 3))) - 1) And 63
       bT = bTmp(0) * 2 ^ 18 + bTmp(1) * 2 ^ 12 + bTmp(2) * 2 ^ 6 + bTmp(3)
       bRet((i \ 4) * 3) = bT \ 65536
       bRet((i \ 4) * 3 + 1) = (bT And 65280) \ 256
       bRet((i \ 4) * 3 + 2) = bT And 255
   Next
   Base64Decode = StrConv(bRet, vbUnicode)
End Function

Function StrToBytes(ByVal Source As String) As Byte()
    Dim bB64Str() As Byte
    bB64Str = StrConv(Source, vbFromUnicode)
    Dim lB64Len As Long
    lB64Len = InStrB(bB64Str, ChrB$(Asc("="))) - 1
    Dim lLenPad As Long
    lLenPad = (4 - lB64Len Mod 4) Mod 4
    Dim lLen As Long
    lLen = ((lB64Len + lLenPad) \ 4) * 3
    Dim bStr() As Byte
    ReDim bStr(lLen - 1)
    lLen = lLen - lLenPad
    Dim i As Long
    Dim lBuffer As Long
    For i = 0 To lB64Len - 1 Step 4
        lBuffer = DeB64CodeA(bB64Str(i + 0)) * &H40000 Or DeB64CodeA(bB64Str(i + 1)) * &H1000& _
                Or DeB64CodeA(bB64Str(i + 2)) * &H40& Or DeB64CodeA(bB64Str(i + 3))
        bStr((i \ 4) * 3 + 2) = lBuffer And &HFF&
        lBuffer = lBuffer \ &H100&
        bStr((i \ 4) * 3 + 1) = lBuffer And &HFF&
        lBuffer = lBuffer \ &H100&
        bStr((i \ 4) * 3 + 0) = lBuffer And &HFF&
        lBuffer = lBuffer \ &H100&
    Next
    ReDim Preserve bStr(lLen - 1)
    StrToBytes = bStr
End Function
Private Function DeB64CodeA(ByVal Char As Byte) As Byte
    Select Case Char
        Case Asc("A") To Asc("Z"): DeB64CodeA = Char - Asc("A")
        Case Asc("a") To Asc("z"): DeB64CodeA = Char - Asc("a") + 26
        Case Asc("0") To Asc("9"): DeB64CodeA = Char - Asc("0") + 52
        Case Asc("+"): DeB64CodeA = 62
        Case Asc("/"): DeB64CodeA = 63
        Case Asc("="): DeB64CodeA = 64
    End Select
End Function
Function Utf8ToUnicode(ByRef Utf() As Byte) As String
    Dim lRet As Long
    Dim lLength As Long
    Dim lBufferSize As Long
    lLength = UBound(Utf) - LBound(Utf) + 1
    If lLength <= 0 Then Exit Function
    lBufferSize = lLength * 2
    Utf8ToUnicode = String$(lBufferSize, Chr(0))
    lRet = MultiByteToWideChar(CP_UTF8, 0, VarPtr(Utf(0)), lLength, StrPtr(Utf8ToUnicode), lBufferSize)
    If lRet <> 0 Then
        Utf8ToUnicode = Left(Utf8ToUnicode, lRet)
    End If
End Function

        #region base64解碼
        public static string base64GbkDecode(string data)
        {
            string decode = "";
            byte[] bytes = Convert.FromBase64String(data);
            try
            {
                decode = Encoding.GetEncoding("gb2312").GetString(bytes);
            }
            catch (Exception ex1)
            {
                //return "Error in base64Encode" + ex1.Message;
            }
            return decode;
        }

        public static string base64Utf8Decode(string data)
        {
            string result = "";
            try
            {
                System.Text.UTF8Encoding encoder = new System.Text.UTF8Encoding();
                System.Text.Decoder utf8Decode = encoder.GetDecoder();
                byte[] todecode_byte = Convert.FromBase64String(data);
                int charCount = utf8Decode.GetCharCount(todecode_byte, 0, todecode_byte.Length);
                char[] decoded_char = new char[charCount];
                utf8Decode.GetChars(todecode_byte, 0, todecode_byte.Length, decoded_char, 0);
                result = new String(decoded_char);
            }
            catch (Exception e)
            {
                //return "Error in base64Encode" + e.Message;
            }
            return result;
        }

        //base64解碼
        public static string DecodeStr(string allstr, string code)
        {
            //形如=?...?=是結(jié)束開始的標(biāo)志
            //=?utf-8?B?5rWL6K+V5o6l5pS25pys6YKu5Lu26L+Z5piv5Li76aKY?=
            //=?gbk?B?suLK1L3TytXN4rK/08q8/tXiuPbKx9b3zOU=?=
            //返回的字符串
            string str = "";
            if (code == "gbk")
            {
                str = base64GbkDecode(allstr);
            }
            else if (code == "utf-8")
            {
                str = base64Utf8Decode(allstr);
            }
            return str;
        }
        #endregion

string subjectStr = popMail.Messages[i].Headers.GetHeader("Subject");
subjectstr = DecodeStr(subjectallstr.Split('?')[3], “utf-8”);