Soyez le premier à donner votre avis sur cette source.
Vue 14 311 fois - Téléchargée 532 fois
'************************************************************************' '************************************************************************' '** **' '** 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) _
28 mai 2007 à 20:25
Peut tu me répondre a lbastou@hotmail.fr
merci
23 juin 2006 à 21:55
"Exit Function" seul ne marche pas puisque B64Chr est variant :
B64Chr("001101") = "N"
B64Chr("") = ""
B64Chr("011_00") = Null
J'ai choisi ces reponses afin de pouvoir utiliser B64Encode ou B64Decode en boucle (dans un For ou un While).
Par exemple si on decode ligne apres ligne la source d'un mail. chaque ligne va renvoyer un resultat en hexadecimal et un eventuel reste binaire qui pourra etre introduit dans le decodage de la ligne suivante. Si en cas d'erreur, je renvoyait "", la boucle continuerais sans probleme. Alors qu'en cas d'erreur, tout soit s'arreter. Donc je renvoie Null et laisse le soin au programme appelant de gerer ce cas.
Salut Katsankat,
Desole pour la "defensive". En fait, c'est un texte tout fait que je colle a la fin de mes sources (quelle pretention, je crois que je n'en ai que 3). Je suis souvent choque par le ton des commentaires sur VBFrance et beaucoup sont tout a fait inutiles.
J'ai enormement travaille ce module. J'ai encore plus travaille ses commentaires (desole pour la langue, j'ai appris comme ca ;o). Je n'attend pas que ca plaise ou pas, j'attend que ca marche parfaitement et si ca ne marche pas qu'on me le dise... Et si ca pouvait marcher mieux aussi (ce qu'a propose Renfeld).
Ciao a vous deux et merci pour vos commentaires.
Santiago
23 juin 2006 à 18:55
Ca a l' air correct, bien que je te sente un peu sur la défensive.
Mérite une bonne note parce que tu as pris le temps pour bien présenter et expliquer ce qui se passe. Et puis, respect pour les commentaires.
Me tarde de tester :)
23 juin 2006 à 16:16
ce genre de test :
If BinString "" Then B64Chr "": Exit Function
peux simplement devenir :
If BinString = "" Then Exit Function
ou encore :
If Lenb( BinString ) > 0 Then
...
End If
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.