Showing posts with label Encode. Show all posts

Base64 編解碼

Posted In: C# , Decode , Encode , VB6 , VBA . By 卡西卡

/// <summary>
/// 應用程式的主進入點。
/// </summary>
[STAThread]
static void Main(string[] args)
{
 string Text = "[123 & abc & 中文]";
 string Base64String = string.Empty;

Base64String = Base64_Encode(Text);
 Console.WriteLine(Base64String); 
 // WwAxADIAMwAgACYAIABhAGIAYwAgACYAIAAtTodlXQA=

Text = Base64_Decode(Base64String);
 Console.WriteLine(Text);
}

/// <summary>
/// 將明文以Base64編碼
/// </summary>
/// <param name="cleanString">明文</param>
/// <returns>編碼</returns>
/// <remarks>
/// 若要同VB交換資料，
/// 要改用System.Text.Encoding.ASCII.GetBytes
/// </remarks>
public static string Base64_Encode(string data)
{
 Byte[] byteData = System.Text.Encoding.Unicode.GetBytes(data);
 return Convert.ToBase64String(byteData);
}
/// <summary>
/// 將Base64解成文字
/// </summary>
/// <param name="data"></param>
/// <returns></returns>
/// <remarks>
/// 若要同VB交換資料，
/// 要改用System.Text.Encoding.ASCII.GetString
/// </remarks>
public static string Base64_Decode(string data)
{
 Byte[] byteData = Convert.FromBase64String(data);
 return System.Text.Encoding.Unicode.GetString(byteData);
}

VB, VBA - 中文不支援

Option Explicit
Public Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, source As Any, ByVal Length As Long)

Private Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

' 中文不支援
Public Sub Test()
    Dim Text As String, Base64String As String
    Text = "[123 & abc]"
    
    Base64String = Base64_Encode(Text)
    Debug.Print Base64String ' WzEyMyAmIGFiY10=
    
    Text = Base64_Decode(Base64String)
    Debug.Print Text
End Sub

' 編碼
Public Function Base64_Encode(data As String) As String
On Error GoTo EH
    Dim byteData() As Byte
    byteData() = StrConv(data, vbFromUnicode)
    Call Base64Array_Encode(byteData)
    Base64_Encode = ToBase64String(byteData)

Exit Function
EH:
    Base64_Encode = ""
End Function

' 解碼
Public Function Base64_Decode(data As String) As String
On Error GoTo EH
    Dim byteData() As Byte
    byteData() = ToArray(data)
    Call Base64Array_Decode(byteData)
    Base64_Decode = ToString(byteData)

Exit Function
EH:
    Base64_Decode = ""
End Function

Private Sub Base64Array_Encode(ByteArray() As Byte)
    Dim OutStream() As Byte
    Dim OutPos As Long
    Dim InpPos As Long
    Dim c1, c2, c3 As Integer
    ReDim OutStream(500)
    InpPos = 0
    OutPos = 0
    Do While InpPos <= UBound(ByteArray)
        c1 = ReadValue(ByteArray, InpPos)
        c2 = ReadValue(ByteArray, InpPos)
        c3 = ReadValue(ByteArray, InpPos)
        Call AddValueToStream(OutStream, OutPos, mimeencode(Int(c1 / 4)))
        Call AddValueToStream(OutStream, OutPos, mimeencode((c1 And 3) * 16 + Int(c2 / 16)))
        If InpPos - 2 <= UBound(ByteArray) Then
            Call AddValueToStream(OutStream, OutPos, mimeencode((c2 And 15) * 4 + Int(c3 / 64)))
        End If
        If InpPos - 1 <= UBound(ByteArray) Then
            Call AddValueToStream(OutStream, OutPos, mimeencode(c3 And 63))
        End If
    Loop
    ReDim ByteArray(OutPos - 1)
    Call CopyMem(ByteArray(0), OutStream(0), OutPos)
End Sub

Private Sub Base64Array_Decode(ByteArray() As Byte)
    Dim OutStream() As Byte
    Dim OutPos As Long
    Dim InpPos As Long
    Dim w1, w2, w3, w4 As Integer
    ReDim OutStream(500)
    InpPos = 0
    OutPos = 0
    Do While InpPos < UBound(ByteArray)
        w1 = mimedecode(ReadValue(ByteArray, InpPos))
        w2 = mimedecode(ReadValue(ByteArray, InpPos))
        w3 = mimedecode(ReadValue(ByteArray, InpPos))
        w4 = mimedecode(ReadValue(ByteArray, InpPos))
        If w2 >= 0 Then Call AddValueToStream(OutStream, OutPos, (w1 * 4 + Int(w2 / 16)) And 255)
        If w3 >= 0 Then Call AddValueToStream(OutStream, OutPos, (w2 * 16 + Int(w3 / 4)) And 255)
        If w4 >= 0 Then Call AddValueToStream(OutStream, OutPos, (w3 * 64 + w4) And 255)
    Loop
    ReDim ByteArray(OutPos - 1)
    Call CopyMem(ByteArray(0), OutStream(0), OutPos)
End Sub

Private Function mimeencode(W As Integer) As Byte
   If W >= 0 Then mimeencode = Asc(Mid$(Base64, W + 1, 1)) Else mimeencode = 0
End Function

Private Function mimedecode(A As Integer) As Integer
   If A = 0 Then mimedecode = -1: Exit Function
   mimedecode = InStr(Base64, Chr(A)) - 1
End Function

Private Function ReadValue(FromArray() As Byte, FromPos As Long) As Integer
    If FromPos <= UBound(FromArray) Then
        ReadValue = FromArray(FromPos)
    Else
        ReadValue = 0
    End If
    FromPos = FromPos + 1
End Function

Private Sub AddValueToStream(ToStream() As Byte, ToPos As Long, Number As Byte)
    If ToPos > UBound(ToStream) Then ReDim Preserve ToStream(ToPos + 100)
    ToStream(ToPos) = Number
    ToPos = ToPos + 1
End Sub

Private Function ToBase64String(data() As Byte) As String
On Error GoTo ToString_EH
    Dim i As Integer
    ToBase64String = ""
    For i = 0 To UBound(data)
        ToBase64String = ToBase64String & Chr$(data(i))
    Next
    i = (UBound(data) + 1) Mod 4
    If i <> 0 Then
        ToBase64String = ToBase64String & String(4 - i, "=")
    End If
    
    Exit Function
ToString_EH:
    ToBase64String = ""
End Function

Private Function ToString(data() As Byte) As String
On Error GoTo ToString_EH
    Dim i As Integer
    ToString = ""
    For i = 0 To UBound(data)
        ToString = ToString & Chr$(data(i))
    Next
    
    Exit Function
ToString_EH:
    ToString = ""
End Function

Private Function ToArray(data As String) As Byte()
On Error Resume Next
    data = Replace(data, "=", "")
    ToArray = StrConv(data, vbFromUnicode)
    
End Function

Up?

Base64 編解碼

Search This Blog

Blog Archive

參考資料

Categories

工具

好物

Javascript Framework

funP