iT邦幫忙

2017 iT 邦幫忙鐵人賽
DAY 20
2
自我挑戰組

Access VBA的眉眉角角系列 第 20

Access VBA 的眉眉角角Day20: Base64編碼與解碼

關於Base64,對許多人而言應該是很陌生的,但如果你有研究過e-mail的編碼,就會發現這蠻常用到的,尤其是e-mail夾檔的資料,幾乎都是用此方式,將二進位資料編碼成文字格式,再夾到信件中使用,關於Base64的資訊可以參考Wikipedia:
https://zh.wikipedia.org/wiki/Base64

今天要介紹,使用VBA來編碼與解碼Base64,以下兩個子程式請放到模組內:
Function Base64Encode(sText)

'http://stackoverflow.com/questions/496751/base64-encode-string-in-vbscript
'修改為適合繁體中文使用

    Dim oXML, oNode
    
    Dim arrData() As Byte
    arrData = StrConv(sText, vbFromUnicode)
    
    Set oXML = CreateObject("Msxml2.DOMDocument.3.0")
    Set oNode = oXML.CreateElement("base64")
    oNode.DataType = "bin.base64"
    oNode.nodeTypedValue = arrData
    
    Base64Encode = oNode.Text
    Set oNode = Nothing
    Set oXML = Nothing
    
    
End Function

Function Base64Decode(ByVal vCode)
    Dim oXML, oNode

    Set oXML = CreateObject("Msxml2.DOMDocument.3.0")
    Set oNode = oXML.CreateElement("base64")
    oNode.DataType = "bin.base64"
    oNode.Text = vCode
    
    Base64Decode = StrConv(oNode.nodeTypedValue, vbUnicode)
    
    Set oNode = Nothing
    Set oXML = Nothing
End Function

這兩個子程式原始的程式碼並沒有針對Unicode進行處理,我改用StrConv函數將Unicode的部份進行處理,這樣才能正常帶出資料。

另外一個測試用的程式也複製到測試模組使用:

Sub Base64測試()
    sText = "測試看看!"
    
    Debug.Print "原始文字:" & sText
    
    sText_Encode = Base64Encode(sText)
    Debug.Print "Base64加密:" & sText_Encode
    
    sText_Decode = Base64Decode(sText_Encode)
    Debug.Print "Base64解密:" & sText_Decode

End Sub

執行後,會出現以下結果:

原始文字:測試看看!
Base64加密:tPq41azdrN2hSQ==
Base64解密:測試看看!

以上兩個程式,是透過微軟的MSXML2物件處理資料,另外,也有透過CDO.Message物件處理資料的方式,可將以下資料放到模組中使用:

Function MailDecode(SourceData, CharSet, EncodeType)
'SourceData:   來源資料(文字字串資料)
'CharSet:      字元集  (big5,UTF8等)
'EncodeType:   編碼類型(quoted-printable、base64等)
    
'來源日文網站:http://takryou79dev.blogspot.mx/2013/06/vbscript-maildecode44k544oe44kk44or44ox.html
'微軟的參考資料:https://msdn.microsoft.com/en-us/library/aa487383(v=exchg.65).aspx
'應該由這裡改寫:http://www.motobit.com/tips/detpg_quoted-printable-decode/
    
    'Create CDO.Message object For the encoding.
    Dim Message: Set Message = CreateObject("CDO.Message")
    
    'Set the encoding
    Message.BodyPart.ContentTransferEncoding = EncodeType
    
    'Get the data stream To write source string data
    Dim Stream 'As ADODB.Stream
    Set Stream = Message.BodyPart.GetEncodedContentStream
    
    If VarType(SourceData) = vbString Then
      'Set charset To base windows charset
      Stream.CharSet = "windows-1250"
      'Write the VBScript string To the stream.
      Stream.WriteText SourceData
    Else
      'Set the type of the stream To adTypeBinary.
      Stream.Type = 1
     
      'Write the source binary data To the stream.
      Stream.Write SourceData
    End If
    
    'Store the data To the message BodyPart
    Stream.Flush
    
    'Get an encoded stream
    Set Stream = Message.BodyPart.GetDecodedContentStream
    
    'Set the type of the stream To adTypeBinary.
    Stream.CharSet = CharSet
    
    'You can use Read method To get a binary data.
    MailDecode = Stream.ReadText

End Function

以下程式碼可寫入UTF8格式的文字檔:

Function WriteToUTF8_Text(strData As String, sFileName As String)
'將UTF-8資料寫入到純文字檔
Dim fsT As Object
Set fsT = CreateObject("ADODB.Stream")
fsT.Type = 2 'Specify stream type - we want To save text/string data.
fsT.CharSet = "utf-8" 'Specify charset For the source text data.

fsT.Open 'Open the stream And write binary data To the object

fsT.WriteText strData

fsT.Position = 3

Dim BinaryStream As Object
Set BinaryStream = CreateObject("adodb.stream")
BinaryStream.Type = 2
BinaryStream.Mode = 3
BinaryStream.CharSet = "utf-8"
BinaryStream.Open

fsT.CopyTo BinaryStream
fsT.Flush
fsT.Close

BinaryStream.SaveToFile sFileName, 2
BinaryStream.Flush
BinaryStream.Close
    
'fsT.SaveToFile sFileName, 2 'Save binary data To disk

End Function

另外測試用的程式碼如下:

Sub MailDecode測試()
    Dim strHTML As String
    
    '表請參閱
    SourceData = "=AA=ED=BD=D0=B0=D1=BE\=20"
    Debug.Print MailDecode(SourceData, "big5", "quoted-printable")
    
    '測試看看!
    SourceData = "tPq41azdrN2hSQ=="
    Debug.Print MailDecode(SourceData, "big5", "base64")
    
    '將base64編碼的檔案解開並儲存
    SourceData = Config("夾檔", True)
    strHTML = MailDecode(SourceData, "utf-8", "base64")
    WriteToUTF8_Text strHTML, "D:\temp\TEST.html"
    RunCMD2 "notepad D:\temp\TEST.html", False, True, 1
    
    
End Sub

這個子程式除了可以解Base64外,也可以指定其他的編碼方式,這裡就用e-mail常見的另一個編碼「quoted-printable」進行測試,關於此編碼,可以參考以下Wikipedia內容:
https://zh.wikipedia.org/wiki/Quoted-printable

執行後,將會出現也下內容,並使用記事本開啟轉出的html檔案:

表請參閱 
測試看看!

各位測試時,可以找封有夾檔的email,並查閱該夾檔於信件原始內容的Base64格式字串,然後於Config資料表中,建立一個Name為「夾檔」的紀錄,並把這字串貼到Note中。

以上教學如果有不懂之處,歡迎留言詢問。希望這些資訊對各位有所幫助。


上一篇
Access VBA 的眉眉角角Day19: 取得字串中的指定資料
下一篇
Access VBA 的眉眉角角Day21: XML/HTML特殊字元轉換與URL加碼與解碼
系列文
Access VBA的眉眉角角30

2 則留言

0
mis2000lab
iT邦好手 1 級 ‧ 2016-12-21 10:18:48

Good,感恩分享 :-)

0
牛哥
iT邦好手 1 級 ‧ 2016-12-21 10:21:44

沒坐到沙發!
/images/emoticon/emoticon02.gif

長知識也不錯。

我要留言

立即登入留言