Jmail接收到的郵件，如果標題的編碼方式是UTF-8的話，直接從Base64解碼出來的話中文會出現亂碼(英文正常)，這就導致用Jmail組件收發(fā)郵件時有些郵箱的正常，有些郵箱亂碼，不夠完善。
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 "郵箱名", "密碼", "服務器" [,"端口號"]
' Debug.Print "你有" & JMail.Count & "封郵件" '郵件數量
For i = 1 To JMail.Count
' EmailID = JMail.GetMessageUID(I) '郵件唯一ID標識
Set EmailMsg = JMail.Messages.Item(i) '取得一條郵件信息
'-----------------------------------------------------------------------------取得附件數量并下載
Set atts = EmailMsg.Attachments '附件集合
Attachment = atts.Count '附件的數量
If Attachment > 0 Then
For J = 0 To Attachment - 1
Set att = atts(J)
If Dir(App.Path & "\" & att.Name) = "" Then 'att.Name附件的名稱，如果存在同名文件而不加判斷則會出錯
att.SaveToFile App.Path & "\" & att.Name
End If
Next J
End If
'------------------------------------------------------------------------------以下為各種參數設置
' EmailMsg.Charset = "gb2312" '編碼方式
' EmailMsg.ContentTransferEncoding = "base64"'解碼方式
' EmailMsg.Encoding = "base64"
' EmailMsg.ContentType = "multipart/mixed" '發(fā)送郵件時
' EmailMsg.ContentType = "text/html" '接收郵件時
' EmailMsg.ISOEncodeHeaders = False'True '功能不清？
'-----------------------------------------------------------------------------可以取得的各元素
' MsgBox EmailMsg.Priority '郵件的優(yōu)先級，1-5，1最高，正常情況為3。
' MsgBox EmailMsg.From '郵件的發(fā)送人的信箱地址
' MsgBox EmailMsg.FromName '郵件的發(fā)送人
' MsgBox EmailMsg.Date '郵件日期
' MsgBox EmailMsg.Body '郵件內容
' MsgBox EmailMsg.Size '郵件大小
'----------------------------------------------------------------------------
Subject = EmailMsg.Headers.GetHeader("Subject") '郵件標題，可正常解碼，但UTF-8格式的標題取不全
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)
{
//形如=?...?=是結束開始的標志
//=?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”);
注意：如果原來頁面用的是UTF-8編碼，一定要用popMail.Messages[i].Headers.GetHeader(“Subject”)的形式，popMail.Messages[i].Subject得到的將是直接經jmail解碼后的亂碼
400 186 1886
