cette fonction n'est pas la mienne j'ai juste apporté une petite modification pour optimiser la vitesse de décodage surtout quand on veut décoder des fichiers attachés de + 1Mo.
Source / Exemple :
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long
Private Function Base64Decode(base64String as string)
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim dataLength As Double
Dim sOut As String
Dim groupBegin As Double
Dim numDataBytes, nGroup
Dim thischar As String * 1
Dim pOut As String
Dim CharCounter As Byte
Dim thisData As Byte
Dim qq As Double
'Dim cond As Boolean
Dim amine() As String * 4
base64String = Replace(base64String, vbCrLf, "")
base64String = Replace(base64String, vbTab, "")
base64String = Replace(base64String, " ", "")
'la longueur de la chaîne passée doit être un multiple de 4
dataLength = Len(base64String)
If dataLength Mod 4 <> 0 Then
Err.Raise 1, "Base64Decode", "Bad Base64 string."
Exit Function
End If
ReDim amine(dataLength / 4)
For i = 0 To (dataLength / 4) - 1
amine(i) = Mid(base64String, (i * 4) + 1, 4)
Next i
' Decodage de chaque groupe:
kk = UBound(amine)
For groupBegin = 0 To kk - 1
' Chaque groupe se transforme en 3 octets.
numDataBytes = 3
nGroup = 0
For CharCounter = 0 To 3
' On convertit chaque caractère en 6 bits de données, et l'ajouter à un
'entier pour assurer le stockage temporaire. Si le caractère est
'un '=', il y a un byte de données de moins (il ne peut avoir que 2 '=' au
'maximum dans toute la chaine).
thischar = Mid(amine(groupBegin), CharCounter + 1, 1)
If thischar = "=" Then
numDataBytes = numDataBytes - 1
thisData = 0
Else
thisData = InStr(1, Base64, thischar, vbBinaryCompare) - 1
End If
nGroup = 64 * nGroup + thisData
Next
'Hex divise l'entier long en 6 groupes de 4 bits
nGroup = Hex(nGroup)
'Ajout des zéros de tête
nGroup = String(6 - Len(nGroup), "0") & nGroup
'Conversion de l'entier en héxa en 3 caractères
qq = GetTickCount
pout = pout & Left(Chr(CByte("&H" & Mid(nGroup, 1, 2))) + _
Chr(CByte("&H" & Mid(nGroup, 3, 2))) + _
Chr(CByte("&H" & Mid(nGroup, 5, 2))), numDataBytes)
'concatenation avec la chaîne de sortie mais si le temps de l'opération dépasse 1ms on purge la variable pout
' géneralement vu la taille des fichiers attachés on a pas besoin de + de 2 variables "purgeables"
If GetTickCount - qq > 1 Then
rr = GetTickCount
zout = zout & pout
If GetTickCount - rr > 1 Then
sOut = sOut & zout
zout = ""
End If
pout = ""
DoEvents
End If
Next
Base64Decode = sOut & zout & pout
End Function
Conclusion :
je veux remercier celui qui a fait cette source à l'origine, j'ai essayé de retrouver son auteur mais g pas réussi
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.