Base64 decodage

Contenu du snippet

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

A voir également

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.