Base64 decodage

Soyez le premier à donner votre avis sur cette source.

Snippet vu 13 669 fois - Téléchargée 31 fois

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

Ajouter un commentaire

Commentaires

Messages postés
1
Date d'inscription
mardi 14 mars 2006
Statut
Membre
Dernière intervention
14 mars 2006

Hassine, tu écris comme explication finale :
" ...je veux remercier celui qui a fait cette source à l'origine, j'ai essayé de retrouver son auteur mais g pas réussi..."

Donc, pour ton information, l'auteur du code original de ta fonction de nomme Antonin Foller et le source origianl peut être trouvé à :
http://www.motobit.com/tips/detpg_Base64/

Il commence comme suit :

' Decodes a base-64 encoded string (BSTR type).
' 1999 - 2004 Antonin Foller, http://www.motobit.com
' 1.01 - solves problem with Access And 'Compare Database' (InStr)
Function Base64Decode(ByVal base64String)
'rfc1521
'1999 Antonin Foller, Motobit Software, http://Motobit.cz
Messages postés
28
Date d'inscription
jeudi 9 juin 2005
Statut
Membre
Dernière intervention
6 juillet 2005

merci infiniement...c'est vraiement mon soucis actuel de tranformer la chaine en base64 ( US ASCII quoi ! )
Messages postés
23
Date d'inscription
mardi 19 octobre 2004
Statut
Membre
Dernière intervention
16 avril 2007

Je ne travaille pas avec le codage c'est le décodage qui m'interesse donc je vais essayer de créer la fonction inversion et je la posterai le plus vite possible promis!
Messages postés
28
Date d'inscription
jeudi 9 juin 2005
Statut
Membre
Dernière intervention
6 juillet 2005

Pouuriez vous m'aider s 'il vous plait ...tout ce que je veux faire c 'est convertir une chaine de caracteres de longuer variable en une autre chaine en base64 pour pouvoir l'analyser selon un autre traitement ensuite !

je suis vraiement coincé !

merci
Messages postés
28
Date d'inscription
jeudi 9 juin 2005
Statut
Membre
Dernière intervention
6 juillet 2005

Je viens de tester la fonction mais ca ne marche pas !! j'arrive pas a convertir ma chaine de caractere ...une erreur vbscript est affiche :
Microsoft VBScript runtime (0x800A000D)
Type mismatch: 'MyASC'
/cyb8_v2/entete/entete.asp, line 147
Afficher les 28 commentaires

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.