Base64 Decode / Encode Using VB 6

Source : http://jacket-cyber.co.cc/2011/04/base64-decode-encode/

Assalamuaalaikum..

Selamat siang teman – teman..

hore..setelah sekian lama tak berkutat dengan visual basic, sekarang saanya share lagi mengenai Visual Basic 6..

oke,seperti teman – teman teman ketahui..

untuk methode enkripsi sendiri ada banyak jenisnya., apalagi MD5 yg dibuat menggunakan VB 6..wah,sudah bertebaran dimana – mana..

Berikut saya berikan sedikit Fungsi Untuk Membuat Encode Decode Base64 dengan menggunakan VB6..

mana dia codingnya ??

oke,mari kita bercoding ria dengan Visual Basic 6.0..
[quote]

Option Explicit

Private InitDone As Boolean
Private Map1(0 To 63) As Byte
Private Map2(0 To 127) As Byte

' Encodes a string into Base64 format.
' No blanks or line breaks are inserted.
' Parameters:
' S a String to be encoded.
' Returns: a String with the Base64 encoded data.
Public Function Base64EncodeString(ByVal s As String) As String
Base64EncodeString = Base64Encode(ConvertStringToBytes(s))
End Function

' Encodes a byte array into Base64 format.
' No blanks or line breaks are inserted.
' Parameters:
' InData an array containing the data bytes to be encoded.
' Returns: a string with the Base64 encoded data.
Public Function Base64Encode(InData() As Byte)
Base64Encode = Base64Encode2(InData, UBound(InData) - LBound(InData) + 1)
End Function

' Encodes a byte array into Base64 format.
' No blanks or line breaks are inserted.
' Parameters:
' InData an array containing the data bytes to be encoded.
' InLen number of bytes to process in InData.
' Returns: a string with the Base64 encoded data.
Public Function Base64Encode2(InData() As Byte, ByVal InLen As Long) As String
If Not InitDone Then Init
If InLen = 0 Then Base64Encode2 = "": Exit Function
Dim ODataLen As Long: ODataLen = (InLen * 4 + 2) \ 3 ' output length without padding
Dim OLen As Long: OLen = ((InLen + 2) \ 3) * 4 ' output length including padding
Dim Out() As Byte
ReDim Out(0 To OLen - 1) As Byte
Dim ip0 As Long: ip0 = LBound(InData)
Dim ip As Long
Dim op As Long
Do While ip < InLen
Dim i0 As Byte: i0 = InData(ip0 + ip): ip = ip + 1
Dim i1 As Byte: If ip < InLen Then i1 = InData(ip0 + ip): ip = ip + 1 Else i1 = 0
Dim i2 As Byte: If ip < InLen Then i2 = InData(ip0 + ip): ip = ip + 1 Else i2 = 0
Dim o0 As Byte: o0 = i0 \ 4
Dim o1 As Byte: o1 = ((i0 And 3) * &H10) Or (i1 \ &H10)
Dim o2 As Byte: o2 = ((i1 And &HF) * 4) Or (i2 \ &H40)
Dim o3 As Byte: o3 = i2 And &H3F
Out(op) = Map1(o0): op = op + 1
Out(op) = Map1(o1): op = op + 1
Out(op) = IIf(op < ODataLen, Map1(o2), Asc("=")): op = op + 1
Out(op) = IIf(op < ODataLen, Map1(o3), Asc("=")): op = op + 1
Loop
Base64Encode2 = ConvertBytesToString(Out)
End Function

' Decodes a string from Base64 format.
' Parameters:
' s a Base64 String to be decoded.
' Returns a String containing the decoded data.
Public Function Base64DecodeString(ByVal s As String) As String
If s = "" Then Base64DecodeString = "": Exit Function
Base64DecodeString = ConvertBytesToString(Base64Decode(s))
End Function

' Decodes a byte array from Base64 format.
' Parameters
' s a Base64 String to be decoded.
' Returns: an array containing the decoded data bytes.
Public Function Base64Decode(ByVal s As String) As Byte()
If Not InitDone Then Init
Dim IBuf() As Byte: IBuf = ConvertStringToBytes(s)
Dim ILen As Long: ILen = UBound(IBuf) + 1
If ILen Mod 4 <> 0 Then Err.Raise vbObjectError, , "Length of Base64 encoded input string is not a multiple of 4."
Do While ILen > 0
If IBuf(ILen - 1) <> Asc("=") Then Exit Do
ILen = ILen - 1
Loop
Dim OLen As Long: OLen = (ILen * 3) \ 4
Dim Out() As Byte
ReDim Out(0 To OLen - 1) As Byte
Dim ip As Long
Dim op As Long
Do While ip < ILen
Dim i0 As Byte: i0 = IBuf(ip): ip = ip + 1
Dim i1 As Byte: i1 = IBuf(ip): ip = ip + 1
Dim i2 As Byte: If ip < ILen Then i2 = IBuf(ip): ip = ip + 1 Else i2 = Asc("A")
Dim i3 As Byte: If ip < ILen Then i3 = IBuf(ip): ip = ip + 1 Else i3 = Asc("A")
If i0 > 127 Or i1 > 127 Or i2 > 127 Or i3 > 127 Then _
Err.Raise vbObjectError, , "Illegal character in Base64 encoded data."
Dim b0 As Byte: b0 = Map2(i0)
Dim b1 As Byte: b1 = Map2(i1)
Dim b2 As Byte: b2 = Map2(i2)
Dim b3 As Byte: b3 = Map2(i3)
If b0 > 63 Or b1 > 63 Or b2 > 63 Or b3 > 63 Then _
Err.Raise vbObjectError, , "Illegal character in Base64 encoded data."
Dim o0 As Byte: o0 = (b0 * 4) Or (b1 \ &H10)
Dim o1 As Byte: o1 = ((b1 And &HF) * &H10) Or (b2 \ 4)
Dim o2 As Byte: o2 = ((b2 And 3) * &H40) Or b3
Out(op) = o0: op = op + 1
If op < OLen Then Out(op) = o1: op = op + 1
If op < OLen Then Out(op) = o2: op = op + 1
Loop
Base64Decode = Out
End Function

Private Sub Init()
Dim c As Integer, i As Integer
' set Map1
i = 0
For c = Asc("A") To Asc("Z"): Map1(i) = c: i = i + 1: Next
For c = Asc("a") To Asc("z"): Map1(i) = c: i = i + 1: Next
For c = Asc("0") To Asc("9"): Map1(i) = c: i = i + 1: Next
Map1(i) = Asc("+"): i = i + 1
Map1(i) = Asc("/"): i = i + 1
' set Map2
For i = 0 To 127: Map2(i) = 255: Next
For i = 0 To 63: Map2(Map1(i)) = i: Next
InitDone = True
End Sub

Private Function ConvertStringToBytes(ByVal s As String) As Byte()
Dim b1() As Byte: b1 = s
Dim l As Long: l = (UBound(b1) + 1) \ 2
If l = 0 Then ConvertStringToBytes = b1: Exit Function
Dim b2() As Byte
ReDim b2(0 To l - 1) As Byte
Dim p As Long
For p = 0 To l - 1
Dim c As Long: c = b1(2 * p) + 256 * CLng(b1(2 * p + 1))
If c >= 256 Then c = Asc("?")
b2(p) = c
Next
ConvertStringToBytes = b2
End Function

Private Function ConvertBytesToString(b() As Byte) As String
Dim l As Long: l = UBound(b) - LBound(b) + 1
Dim b2() As Byte
ReDim b2(0 To (2 * l) - 1) As Byte
Dim p0 As Long: p0 = LBound(b)
Dim p As Long
For p = 0 To l - 1: b2(2 * p) = b(p0 + p): Next
Dim s As String: s = b2
ConvertBytesToString = s
End Function


Semoga Bermanfaat ^_^