Codage en base 64
Description
Description _________________
Ce module a inclure dans vos applications fourni deux procedures pour coder et decoder en utilisant le codage en "base64". Ce code base sur 64 caracteres est principalement utilise pour transferer des fichiers par mail puisqu'il utilise un jeu de caracteres non ambigus par rapport aux alphabets internationaux, c'est a dire les caracteres latin non accentues, les chiffres et les caracteres plus ("+") et barre oblique ("/").
Fonctionnement ______________
26 majuscules + 26 minuscules + 10 chiffres + plus + barre oblique = 64 caracteres
6 bits sont necessaires pour coder chaque caractere en base64 (2 ^ 6 = 64)
(1 - CODAGE) Un fichier apparait comme une suite d'octets (8 bits). Chaque groupe de 3 octets font 24 bits ce qui correspond a 4 caracteres base64. A la fin du fichier, il peut rester 1 ou 2 octets (8 ou 16 bits) :
8 bits sont completes avec 4 zeros, ce qui fait 12 bits soit 2 caracteres base64. Ces 2 caracteres sont completes a 4 en utilisant le caractere de remplissage ("=").
16 bits sont completes avec 2 zeros, ce qui fait 18 bits soit 3 caracteres base64 qui sont completes a 4 avec un caractere de remplissage ("=").
Un retour charriot (Chr(13) & Chr(10)) est ajoute tous les 76 caracteres pour respecter les limitations des mails.
(2 - DECODAGE) Chaque groupe de 4 caracteres base64 font 24 bits soit 3 octets. A la fin du texte en base64, il peut rester 2 ou 3 caracteres: les caracteres de remplissage ("=") sont ignores et 1 seul caracteres est impossible d'apres les regles de codage.
2 caracteres font 12 bits, arrondi a 8 qui font 1 octets.
3 caracteres font 18 bits, arrondi a 16 qui font 2 octets.
Utilisation _________________
Pour coder un fichier vers une variable texte :
Dim Base64Texte, MonFichier
MonFichier = "C:\WINDOWS\NOTEPAD.EXE"
Call B64Encode(MonFichier, Base64Texte)
If IsNull(Base64Texte) Then
MsgBox "Erreur : impossible de coder le fichier."
Else
MsgBox "Ajoutez Base64Texte dans un mail."
End If
Pour decoder un texte vers un fichier :
Dim Base64Texte, MonFichier
Base64Texte = "///+AAya6A/ff+AAAA=="
MonFichier = "C:\Fichier.dat"
Call B64Decode(Base64Texte, MonFichier)
If IsNull(MonFichier) Then
MsgBox "Erreur : impossible de decoder Base64Texte."
Else
MsgBox "Base64Texte a ete decode avec succes dans " & MonFichier & "."
End If
Pour coder une suite de caracteres hexadecimaux vers une variable texte :
Dim Base64Texte, TexteHexa, ResteBinaire
TexteHexa = "A51DEA7611455AD"
ResteBinaire = ""
Call B64Encode(TexteHexa, Base64Texte, ResteBinaire)
If IsNull(Base64Texte) Then
MsgBox "Erreur: TexteHexa n'est pas hexadecimal."
Else
MsgBox "Base64Texte contient le code en base64." & vbCrLf & _
"ResteBinaire contient les bits restant."
End If
Je poste mes codes pour partager des connaissances et des idees.
J'attends des constatations de bugs ou des propositions d'amelioration.
Si vous trouvez ce code inutile ou "deja vu", pas la peine de le consulter et de le commenter.
Si vous eprouvez neanmoins un besoin irrepressible de montrer votre capacite a critiquer, merci de le faire en m'envoyant un message perso afin de ne pas noyer ce code au milieu des polemiques.
Ce module a inclure dans vos applications fourni deux procedures pour coder et decoder en utilisant le codage en "base64". Ce code base sur 64 caracteres est principalement utilise pour transferer des fichiers par mail puisqu'il utilise un jeu de caracteres non ambigus par rapport aux alphabets internationaux, c'est a dire les caracteres latin non accentues, les chiffres et les caracteres plus ("+") et barre oblique ("/").
Fonctionnement ______________
26 majuscules + 26 minuscules + 10 chiffres + plus + barre oblique = 64 caracteres
6 bits sont necessaires pour coder chaque caractere en base64 (2 ^ 6 = 64)
(1 - CODAGE) Un fichier apparait comme une suite d'octets (8 bits). Chaque groupe de 3 octets font 24 bits ce qui correspond a 4 caracteres base64. A la fin du fichier, il peut rester 1 ou 2 octets (8 ou 16 bits) :
8 bits sont completes avec 4 zeros, ce qui fait 12 bits soit 2 caracteres base64. Ces 2 caracteres sont completes a 4 en utilisant le caractere de remplissage ("=").
16 bits sont completes avec 2 zeros, ce qui fait 18 bits soit 3 caracteres base64 qui sont completes a 4 avec un caractere de remplissage ("=").
Un retour charriot (Chr(13) & Chr(10)) est ajoute tous les 76 caracteres pour respecter les limitations des mails.
(2 - DECODAGE) Chaque groupe de 4 caracteres base64 font 24 bits soit 3 octets. A la fin du texte en base64, il peut rester 2 ou 3 caracteres: les caracteres de remplissage ("=") sont ignores et 1 seul caracteres est impossible d'apres les regles de codage.
2 caracteres font 12 bits, arrondi a 8 qui font 1 octets.
3 caracteres font 18 bits, arrondi a 16 qui font 2 octets.
Utilisation _________________
Pour coder un fichier vers une variable texte :
Dim Base64Texte, MonFichier
MonFichier = "C:\WINDOWS\NOTEPAD.EXE"
Call B64Encode(MonFichier, Base64Texte)
If IsNull(Base64Texte) Then
MsgBox "Erreur : impossible de coder le fichier."
Else
MsgBox "Ajoutez Base64Texte dans un mail."
End If
Pour decoder un texte vers un fichier :
Dim Base64Texte, MonFichier
Base64Texte = "///+AAya6A/ff+AAAA=="
MonFichier = "C:\Fichier.dat"
Call B64Decode(Base64Texte, MonFichier)
If IsNull(MonFichier) Then
MsgBox "Erreur : impossible de decoder Base64Texte."
Else
MsgBox "Base64Texte a ete decode avec succes dans " & MonFichier & "."
End If
Pour coder une suite de caracteres hexadecimaux vers une variable texte :
Dim Base64Texte, TexteHexa, ResteBinaire
TexteHexa = "A51DEA7611455AD"
ResteBinaire = ""
Call B64Encode(TexteHexa, Base64Texte, ResteBinaire)
If IsNull(Base64Texte) Then
MsgBox "Erreur: TexteHexa n'est pas hexadecimal."
Else
MsgBox "Base64Texte contient le code en base64." & vbCrLf & _
"ResteBinaire contient les bits restant."
End If
Source / Exemple :
'************************************************************************'
'************************************************************************'
'** **'
'** BASE 64 CODING MODULE **'
'** **'
'************************************************************************'
'************************************************************************'
'---------------------------- PROPERTIES ----------------------------'
'Author = Santiago Diez
'Date = 22 JUNE 2006 17:37
'Version = 1.0
'--------------------------- DESCRIPTION ----------------------------'
'Provide procedures to code and decode using "base64". This 64 characters-
'based code is mainly used for transfering files throught e-mail as it
'only uses non-ambigues character in regard to international alphabets,
'wich means using only latin characters (without accents), numbers and the
'characters plus ("+") and slash ("/").
'--------------------------- HOW IT WORKS ---------------------------'
'26 capitals + 26 letters + 10 digits + plus + slash = 64 characters
'6 bits are necessary to code each base64 characters (2 ^ 6 = 64).
'(1 - ENCODING) A file is viewed as a stream of bytes (8 bits). Each group
'of 3 bytes makes 24 bits that actually makes 4 base64 characters. At the
'end of the file, it may remain 1 or 2 bytes (8 or 16 bits).
'8 bits are completed with 4 zeros, wich makes 12 bits or 2 base64
'characters. Then the 2 characters are completed to 4 using the base64
'feeding character ("=").
'16 bits are completed with 2 zeros, wich makes 18 bits or 3 base64
'characters that are completed to 4 with one feeding character ("=").
'A carriage return?linefeed combination is added every 76 characters to
'reach e-mail rules.
'(2 - DECODING) Each group of 4 base64 characters makes 24 bits or 3
'bytes. At the end of the base64 stream, it may remain 2 or 3 characters:
'feeding characters ("=") are ignored and 1 character is impossible
'following encoding rules.
'2 characters makes 12 bits, rounded down to 8 wich makes 1 byte.
'3 characters makes 18 bits, rounded down to 16 wich makes 2 bytes.
'----------------- PUBLIC PROCEDURES AND FUNCTIONS ------------------'
'B64Encode(HexStream, OutputStream, [BinRem = ""], [StrMultipleLen As Long
' = 4], [LineLen As Long = 76])
'B64Decode(B64Stream, OutputStream, [BinRem = ""], [OverWrite As Boolean
' = False])
'----------------------------- EXAMPLES -----------------------------'
'To code a file to a string variable:
'Dim Base64Stream, MyFile
'MyFile = "C:\WINDOWS\NOTEPAD.EXE"
'Call B64Encode(MyFile, Base64Stream)
'If IsNull(Base64Stream) Then
' MsgBox "Error: could not code file."
'Else
' MsgBox "Print Base64Stream in a mail."
'End If
'To decode a string variable to a file:
'Dim Base64Stream, MyFile
'Base64Stream = "///+AAya6A/ff+AAAA=="
'MyFile = "C:\File.dat"
'Call B64Decode(Base64Stream, MyFile)
'If IsNull(MyFile) Then
' MsgBox "Error: could not decode Base64Stream."
'Else
' MsgBox "Base64Stream was succesfuly saved in " & MyFile & "."
'End If
'To code a hexadecimal string to a string variable:
'Dim Base64Stream, HexString, BinaryRemainder
'HexString = "A51DEA7611455AD"
'BinaryRemainder = ""
'Call B64Encode(HexString, Base64Stream, BinaryRemainder)
'If IsNull(Base64Stream) Then
' MsgBox "Error: HexString is not hexadecimal."
'Else
' MsgBox "Base64Stream contains the base64 code." & vbCrLf & _
' "BinaryRemainder contains the remaining bits."
'End If
'------------------------------- BUGS -------------------------------'
'No bug reported.
'----------------------------- SOURCES ------------------------------'
'None
'----------------------------- SEE ALSO -----------------------------'
'None
'------------------------ REQUIRED LIBRARIES ------------------------'
'msvbvm60.dll VB6.OLB VB6FR.DLL
'-------------------- REQUIRED MODULES AND FORMS --------------------'
'None
'----------------------------- OPTIONS ------------------------------'
Option Base 1
Option Compare Text
Option Explicit
'+----------------------------------------------------------------------+'
'+ GLOBAL VARIABLES +'
'+----------------------------------------------------------------------+'
Private Const BASE64_CHARSET As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZa" & _
"bcdefghijklmnopqrstuvwxyz0123456789+/"
Private Const BASE64_BINSET As String = "000000:000001:000010:000011:" & _
"000100:000101:000110:000111:001000:001001:001010:001011:001100:0" & _
"01101:001110:001111:010000:010001:010010:010011:010100:010101:01" & _
"0110:010111:011000:011001:011010:011011:011100:011101:011110:011" & _
"111:100000:100001:100010:100011:100100:100101:100110:100111:1010" & _
"00:101001:101010:101011:101100:101101:101110:101111:110000:11000" & _
"1:110010:110011:110100:110101:110110:110111:111000:111001:111010" & _
":111011:111100:111101:111110:111111:"
Private Const BASE64_BINSEP As String = ":"
Private Const BASE64_BINLEN As Long = 6
Private Const BASE64_FEED As String = "="
Private Const BASE16_CHARSET As String = "0123456789ABCDEF"
Private Const BASE16_BINSET As String = "0000:0001:0010:0011:0100:010" & _
"1:0110:0111:1000:1001:1010:1011:1100:1101:1110:1111:"
Private Const BASE16_BINSEP As String = ":"
Private Const BASE16_BINLEN As Long = 4
'+----------------------------------------------------------------------+'
'+ ENCODING +'
'+----------------------------------------------------------------------+'
'"B64Encode" is a procedure that codes an hexadecimal stream (string or
'file specification) into a base64 stream (string).
'"HexStream" is the hexadecimal stream to be coded (string or file).
'"OutputStream" is a variable (string) passed by reference in wich is
'stored the base64 stream corresponding to "HexStream".
'"BinRem" is a variable (string) passed by reference that may input the
'binary remainder of any previous coding operation and is returned as the
'binary remainder of this coding operation.
'"StrMultipleLen" fixes the length of "OutputStream" as a multiple of
'"StrMultipleLen". If it is greater than zero, "BinRem" is completed with
'zeros to be converted into a base64 string and added to "OutputStream".
'"OutputStream" is completed with the base64 feeding character to reach
'the nearest multiple length. "BinRem" is set to the zero-length strings
'(""). Default value is 4 as stated in the base64 nomenclature.
'"LineLen" fixes the length of the lines in "OutputStream". If it is
'greater than zero, "B64Encode" adds a carriage return?linefeed
'combination every "LineLen" characters. Default value is 76 as stated in
'the base64 nomenclature.
'If "HexStream" and "BinRem" are both zero-length strings (""),
'"OutputStream" is set to the zero-length string ("").
'If "HexStream" is Null or not hexadecimal and cannot be interpreted as a
'file address, "OutputStream" is set to Null.
'If "BinRem" is Null or not binary, "OutputStream" is set to Null.
'If "StrMultipleLen" is less than zero, it is considered as zero.
'If "LineLen" is less than zero, it is considered as zero.
'Difference between (1) "StrMultipleLen" = 0 and (2) "StrMultipleLen" = 1:
'(1) if there is a binary remainder, it is returned through "BinRem"
'(2) if there is a binary remainder, it is feeded with zeros to make it
'codable into a base64 character (then "BinRem" = "").
Sub B64Encode(HexStream, OutputStream, Optional binrem = "", Optional _
StrMultipleLen As Long = 4, Optional LineLen As Long = 76)
Dim i As Long, j As Long
Dim StrLen As Long
Dim BinRemBackup
BinRemBackup = binrem
On Error GoTo BaseErr
'Try to open "HexStream" as a file
Call OpenFileInHex(HexStream)
'Case "HexStream" = "" and "BinRem" = ""
If CStr(HexStream) & CStr(binrem) = "" _
Then OutputStream = "": Exit Sub
'Calculate "BinRem" length, rounding up to the first "BASE64_BINLEN"
'multiple (if "StrMultipleLen" > 0)
StrLen = Len(binrem) + BASE16_BINLEN * Len(HexStream)
If StrMultipleLen > 0 _
Then StrLen = -Int(-StrLen / BASE64_BINLEN) * BASE64_BINLEN
'Initialize "BinRem"
binrem = String$(StrLen, "0")
Mid$(binrem, 1) = BinRemBackup
'Build binary stream from remainder and hexadecimal stream
j = Len(BinRemBackup) + 1
For i = 1 To Len(HexStream)
Mid$(binrem, j) = CStr(B16Bin(Mid$(HexStream, i, 1)))
j = j + BASE16_BINLEN
Next
'Calculate "OutputStream" length, rounding up to the first
'"StrMultipleLen" multiple
StrLen = Int(Len(binrem) / BASE64_BINLEN)
If StrMultipleLen > 1 _
Then StrLen = -Int(-StrLen / StrMultipleLen) * StrMultipleLen
'Split function in two depending on "LineLen" value
j = 1
If LineLen > 0 Then
StrLen = StrLen + 2 * Int((StrLen - 1) / LineLen)
'Initialize "OutputStream"
OutputStream = String$(StrLen, BASE64_FEED)
For i = LineLen + 1 To Len(OutputStream) Step LineLen + 2
Mid$(OutputStream, i) = vbCrLf
Next
'Build base64 stream from binary stream (except last character)
For i = 1 To Len(binrem) - BASE64_BINLEN Step BASE64_BINLEN
Mid$(OutputStream, j _
) = CStr(B64Chr(Mid$(binrem, i, BASE64_BINLEN)))
j = j + 1 - 2 * ((j + 2) Mod (LineLen + 2) = 0)
Next
Else
'Initialize "OutputStream"
OutputStream = String$(StrLen, BASE64_FEED)
'Build base64 stream from binary stream (except last character)
For i = 1 To Len(binrem) - BASE64_BINLEN Step BASE64_BINLEN
Mid$(OutputStream, j _
) = CStr(B64Chr(Mid$(binrem, i, BASE64_BINLEN)))
j = j + 1
Next
End If
'Add last base64 character (if "StrMultipleLen" > 0) and set "BinRem"
If StrMultipleLen > 0 Then
Mid$(OutputStream, j _
) = CStr(B64Chr(Mid$(binrem, i, BASE64_BINLEN)))
binrem = ""
Else
binrem = Mid$(binrem, i)
End If
Exit Sub
BaseErr:
binrem = BinRemBackup
OutputStream = Null
End Sub
'+----------------------------------------------------------------------+'
'+ DECODING +'
'+----------------------------------------------------------------------+'
'"B64Decode" is a procedure that decodes a base64 stream (string) into an
'hexadecimal stream (string or file specification).
'"B64Stream" is the hexadecimal stream (string) to be decoded.
'"Outputstream" is a variable (string) passed by reference. If it is a
'string expression that specifies a file name (may include directory or
'folder, and drive), "B64Stream" will be decoded to the corresponding
'file. If not, the resulting hexadecimal stream will be stored in variable
'"OutputStream".
'"OverWrite" specifies if "OutputStream" file can be overwritten or not.
'"BinRem" is a variable (string) passed by reference that may input the
'binary remainder of any previous coding operation and is returned as the
'binary remainder of this coding operation.
'If "B64Stream" and "BinRem" are both zero-length strings (""),
'"OutputStream" is set to the zero-length string ("") or the specified
'file is saved as a blank file (0 kb).
'If "B64tream" Is Null Or Not base64², "OutputStream" is set to Null¹.
'If "BinRem" is Null or not binary, "OutputStream" is set to Null¹.
'If "OverWrite" is False and the file specified with "OutputStream"
'already exists, "OutputStream" is set to Null¹.
' ¹ It means that even if you want the output to be a file, you should
'always call the procedure giving "OutputStream" a variable rather than a
'constant or string expression. So that you can read that variable after
'"B64Encode" and check for errors.
' ² Carriage return and Line feed characters are ignored but the base64
'feeding character ("=") causes an error.
Sub B64Decode(B64Stream, OutputStream, Optional binrem = "", Optional _
OverWrite As Boolean = False)
Dim i As Long, j As Long
Dim StrLen As Long
Dim BinRemBackup, OutputStreamBackup
BinRemBackup = binrem
OutputStreamBackup = OutputStream
On Error GoTo BaseErr
'Case "B64Stream" = "" and "BinRem" = ""
If CStr(B64Stream) & CStr(binrem) = "" _
Then OutputStream = "": GoTo MakeFile
'Ignore base64 feeding characters ("=") at the end of the stream ¹
StrLen = Len(B64Stream)
Do While Mid$(B64Stream, StrLen, 1) = BASE64_FEED
StrLen = StrLen - 1
Loop
'Initialize "BinRem" ¹
binrem = String$(Len(binrem) + BASE64_BINLEN * StrLen, "0")
Mid$(binrem, 1) = BinRemBackup
'Build binary stream from remainder and base64 stream ¹
j = Len(BinRemBackup) + 1
For i = 1 To StrLen
Select Case Mid$(B64Stream, i, 1)
Case vbCr, vbLf
Case Else
Mid$(binrem, j) = CStr(B64Bin(Mid$(B64Stream, i, 1)))
j = j + BASE64_BINLEN
End Select
Next
'"BinRem" may have been initialized longer than necessary if decoding
'encounters carriage return and/or linefeed characters ¹
binrem = Left$(binrem, j - 1)
'Calculate "OutputStream" length, rounding DOWN to the first multiple
'of 8 (two hexadecimal characters)
StrLen = 2 * Int(Len(binrem) / BASE16_BINLEN / 2)
'Initialize "OutputStream"
OutputStream = String$(StrLen, "0")
'Build hexadecimal stream from binary stream
j = 1
For i = 1 To StrLen
Mid$(OutputStream, i _
) = CStr(B16Chr(Mid$(binrem, j, BASE16_BINLEN)))
j = j + BASE16_BINLEN
Next
'Set "BinRem"
If Right$(B64Stream, 1) = BASE64_FEED _
Then binrem = "" _
Else binrem = Mid$(binrem, j)
MakeFile:
Call SaveFileAsHex(OutputStream, OutputStreamBackup, OverWrite)
Exit Sub
BaseErr:
binrem = BinRemBackup
OutputStream = Null
' ¹ I avoid as much as possible to set string variable with string
'operations like "String = Replace()" or "String = String & String"
'because such operations rewrite entirely the string wich is very time
'consuming specially with long streams.
End Sub
'+----------------------------------------------------------------------+'
'+ HEXADECIMAL TO BINARY FUNCTION +'
'+----------------------------------------------------------------------+'
'Returns the binary code of the first character of hexadecimal string
'"HexString".
'If "HexString" is a zero-length string (""), B16Bin returns a zero-length
'string ("").
'If "HexString" is Null or its first character is not hexadecimal, Null is
'returned.
Private Function B16Bin(HexString)
On Error GoTo ErrBase
If HexString = "" _
Then B16Bin = "" _
Else B16Bin = Mid$(BASE16_BINSET, (BASE16_BINLEN + 1) _
- InStr(BASE16_CHARSET, Left$(HexString _
Conclusion :
Je poste mes codes pour partager des connaissances et des idees.
J'attends des constatations de bugs ou des propositions d'amelioration.
Si vous trouvez ce code inutile ou "deja vu", pas la peine de le consulter et de le commenter.
Si vous eprouvez neanmoins un besoin irrepressible de montrer votre capacite a critiquer, merci de le faire en m'envoyant un message perso afin de ne pas noyer ce code au milieu des polemiques.
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.