Public Function ToBase64(sInput As String) As String
Dim sOutput As String, sLast As String
Dim B(2) As Byte
Dim j As Integer
Dim I As Long, nLen As Long, nQuants As Long
Dim iIndex As Long
nLen = Len(sInput)
nQuants = nLen \ 3
sOutput = String(nQuants * 4, " ")
iIndex = 0
' Now start reading in 3 bytes at a time
For I = 0 To nQuants - 1
For j = 0 To 2
B(j) = Asc(Mid(sInput, (I * 3) + j + 1, 1))
Next
Mid$(sOutput, iIndex + 1, 4) = EncodeQuantum(B)
iIndex = iIndex + 4
Next
' Cope with odd bytes
Select Case nLen Mod 3
Case 0
sLast = ""
Case 1
B(0) = Asc(Mid(sInput, nLen, 1))
B(1) = 0
B(2) = 0
sLast = EncodeQuantum(B)
' Replace last 2 with =
sLast = Left(sLast, 2) & "=="
Case 2
B(0) = Asc(Mid(sInput, nLen - 1, 1))
B(1) = Asc(Mid(sInput, nLen, 1))
B(2) = 0
sLast = EncodeQuantum(B)
' Replace last with =
sLast = Left(sLast, 3) & "="
End Select
ToBase64 = sOutput & sLast
End Function
این کد بالا برای تبدیل متن به بیس 64 هست و این کد پایینی هم برای خواندن از بیس 64 هست ، امید وارم متوجه شده باشید .
Public Function FromBase64(sEncoded As String) As String
Dim sDecoded As String
Dim d(3) As Byte
Dim c As Byte
Dim di As Integer
Dim I As Long
Dim nLen As Long
Dim iIndex As Long
nLen = Len(sEncoded)
sDecoded = String((nLen \ 4) * 3, " ")
iIndex = 0
di = 0
Call MakeDecTab
' Read in each char in trun
For I = 1 To Len(sEncoded)
c = CByte(Asc(Mid(sEncoded, I, 1)))
c = aDecTab(c)
If c >= 0 Then
d(di) = c
di = di + 1
If di = 4 Then
Mid$(sDecoded, iIndex + 1, 3) = DecodeQuantum(d)
iIndex = iIndex + 3
If d(3) = 64 Then
sDecoded = Left(sDecoded, Len(sDecoded) - 1)
iIndex = iIndex - 1
End If
If d(2) = 64 Then
sDecoded = Left(sDecoded, Len(sDecoded) - 1)
iIndex = iIndex - 1
End If
di = 0
End If
End If
Next I
FromBase64 = sDecoded
End Function
خدمت شما
پاسخ با نقل قول
