1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95
|
Private Const mBASE64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Private Function Base64_Encode(ByVal Source As String) As String
Dim C1 As Integer
Dim C2 As Integer
Dim C3 As Integer
Dim W1 As Integer
Dim W2 As Integer
Dim W3 As Integer
Dim W4 As Integer
Dim n As Long
Dim Retry As String
Dim Taille As Double
Dim Pos As Long
Dim Mime As String
'Calcul la taille final de la chaine de caractères
Taille = Len(Source) + (Len(Source) / 3)
If Taille - Int(Taille) <> 0 Then Taille = Int(Taille) + 1
Retry = String(Taille, 0)
Pos = 1
For n = 1 To Len(Source) Step 3
C1 = Asc(mId$(Source, n, 1))
C2 = Asc(mId$(Source, n + 1, 1) + Chr$(0))
C3 = Asc(mId$(Source, n + 2, 1) + Chr$(0))
W1 = Int(C1 / 4)
W2 = (C1 And 3) * 16 + Int(C2 / 16)
If Len(Source) >= n + 1 Then W3 = (C2 And 15) * 4 + Int(C3 / 64) Else W3 = -1
If Len(Source) >= n + 2 Then W4 = C3 And 63 Else W4 = -1
Mime = MimeEncode(W1) & MimeEncode(W2) & MimeEncode(W3) & MimeEncode(W4)
Mid(Retry, Pos, Len(Mime)) = Mime
Pos = Pos + Len(Mime)
Next
Base64_Encode = Retry
End Function
Private Function Base64_Decode(ByVal Source As String) As String
Dim W1 As Integer
Dim W2 As Integer
Dim W3 As Integer
Dim W4 As Integer
Dim n As Long
Dim Retry As String
Dim Pos As Long
Dim Taille As Double
'Calcul la taille final de la chaine de caractères
Taille = Int(Len(Source) * 0.75)
Pos = 1
Retry = String(Taille, 0)
For n = 1 To Len(Source) Step 4
W1 = MimeDecode(mId$(Source, n, 1))
W2 = MimeDecode(mId$(Source, n + 1, 1))
W3 = MimeDecode(mId$(Source, n + 2, 1))
W4 = MimeDecode(mId$(Source, n + 3, 1))
If W2 >= 0 Then
Mid(Retry, Pos, 1) = Chr$(((W1 * 4 + Int(W2 / 16)) And 255))
Pos = Pos + 1
End If
If W3 >= 0 Then
Mid(Retry, Pos, 1) = Chr$(((W2 * 16 + Int(W3 / 4)) And 255))
Pos = Pos + 1
End If
If W4 >= 0 Then
Mid(Retry, Pos, 1) = Chr$(((W3 * 64 + W4) And 255))
Pos = Pos + 1
End If
Next
Base64_Decode = Retry
End Function
Private Function MimeEncode(ByVal w As Integer) As String
If w >= 0 Then
MimeEncode = mId$(mBASE64, w + 1, 1)
Else
MimeEncode = ""
End If
End Function
Private Function MimeDecode(ByVal a As String) As Integer
If Len(a) = 0 Then
MimeDecode = -1
Exit Function
End If
MimeDecode = InStr(mBASE64, a) - 1
End Function |
Partager