1. Accueil
  2. Visual Basic / VB.NET
  3. Sources Visual Basic / VB.NET
  4. Sources Modules
  5. Codage en base 64

Codage en base 64

Soyez le premier à donner votre avis sur cette source.

Vue 14 311 fois - Téléchargée 532 fois

Télécharger le projet
Commenter

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

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 _

                  , 1)) - BASE16_BINLEN, BASE16_BINLEN)
    Exit Function
'HexString is not a hexadecimal digit.
ErrBase:
    B16Bin = Null
End Function
'+----------------------------------------------------------------------+'
'+                      BASE64 TO BINARY FUNCTION                       +'
'+----------------------------------------------------------------------+'
'Returns  the  binary  code  of  the  first  character  of  base64  string
'"B64String".
'If "B64String" is a zero-length string (""), B64Bin returns a zero-length
'string ("").
'If "B64String"  is Null or  its first  character is  not base64,  Null is
'returned.
Private Function B64Bin(B64String)
    On Error GoTo ErrBase
    If B64String = "" Then B64Bin = "" _
    Else B64Bin = Mid$(BASE64_BINSET, (BASE64_BINLEN + 1) * InStr(1, _
                  BASE64_CHARSET, Left(B64String, 1), vbBinaryCompare) _
                  - BASE64_BINLEN, BASE64_BINLEN)
    Exit Function
ErrBase:
    B64Bin = Null
End Function
'+----------------------------------------------------------------------+'
'+                    BINARY TO HEXADECIMAL FUNCTION                    +'
'+----------------------------------------------------------------------+'
'Returns the hexadecimal character  of the first 4 digits of binary string
'"BinString".
'If "BinString" is a zero-length string (""), B16Chr returns a zero-length
'string ("").
'If "BinString" is Null or its length is less than 4 or its first 4 digits
'are not binary, Null is returned.
Private Function B16Chr(BinString)
    On Error GoTo ErrBase
    If BinString = "" Then B16Chr = "": Exit Function
    If Len(CStr(BinString)) < BASE16_BINLEN Then GoTo ErrBase
    B16Chr = Mid$(BASE16_CHARSET, Int((InStr(1, BASE16_BINSET, Left$( _
             BinString, BASE16_BINLEN) & BASE16_BINSEP, vbBinaryCompare) _
             + BASE16_BINLEN) / (BASE16_BINLEN + 1)), 1)
    Exit Function
'BinString is not a binary string.
ErrBase:
    B16Chr = Null
End Function
'+----------------------------------------------------------------------+'
'+                      BINARY TO BASE64 FUNCTION                       +'
'+----------------------------------------------------------------------+'
'Returns  the base64  character  of the first  6 digits  of binary  string
'"BinString".
'If "BinString" is a zero-length string (""), B64Chr returns a zero-length
'string ("").
'If "BinString" is Null or its length is less than 6 or its first 6 digits
'are not binary, Null is returned.
Private Function B64Chr(BinString)
    On Error GoTo ErrBase
    If BinString = "" Then B64Chr = "": Exit Function
    If Len(CStr(BinString)) < BASE64_BINLEN Then GoTo ErrBase
    B64Chr = Mid$(BASE64_CHARSET, Int((InStr(1, BASE64_BINSET, Left$( _
             BinString, BASE64_BINLEN) & BASE64_BINSEP, vbBinaryCompare) _
             + BASE64_BINLEN) / (BASE64_BINLEN + 1)), 1)
    Exit Function
'BinString is not a binary string.
ErrBase:
    B64Chr = Null
End Function

'+----------------------------------------------------------------------+'
'+                  OPEN FILE IN HEXADECIMAL PROCEDURE                  +'
'+----------------------------------------------------------------------+'
'Try to transform a  path to a specific  file (absolute  or relative) into
'the corresponding file hexadecimal stream.
'If "HexStream"  is a string  expression that  specifies a  file name (may
'include  directory  or   folder,  and  drive),   the  corresponding  file
'hexadecimal  stream  is  read  and   stored  into  "HexStream".  If  not,
'"HexStream" remains unchanged.
Private Sub OpenFileInHex(HexStream)
    Dim i As Long
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Dim FileId As Long
    Dim Buffer As Byte
    Dim BufLen As Long
    'Check existence of file specified with "HexStream"
    If Not FSO.FileExists(HexStream) Then GoTo NotFile
    'Try to open file "HexStream" in binary mode
    On Error GoTo ReadErr
    FileId = FreeFile
    BufLen = Len(Buffer)
    Open HexStream For Random As FileId Len = BufLen
    HexStream = String$(2 * BufLen * LOF(FileId), "0")
    For i = 1 To LOF(FileId)
        Get FileId, i, Buffer
        If Buffer < 16 _
        Then Mid$(HexStream, (i - 1) * 2 * BufLen + 2 _
        ) = Hex(Buffer) Else Mid$(HexStream, (i - 1) * 2 * BufLen + 1) = Hex(Buffer)
    Next
    Close FileId
Exit Sub
NotFile:
ReadErr:
End Sub
'+----------------------------------------------------------------------+'
'+              SAVE FILE AS HEXADECIMAL STREAM PROCEDURE               +'
'+----------------------------------------------------------------------+'
'Save a hexadecimal stream (string) to a file.
'"OutputStream" is the hexadecimal stream (string).
'"FileSpec" may  be a string  expression that  specifies a  file name (may
'include directory or folder, and drive).
'"OverWrite" specifies if the file can be overwritten or not.
'If "OutputStream" is Null, no file is created nor modified.
'If "OutputStream" is a  zero-length strings (""),  a blank file (0 kb) is
'created.
'If "OutputStream"  is not  hexadecimal,  it is  set to Null  and the file
'created will probably be corrupted.
'If  "FileSpec"  is  a  string expression  that  specifies  a  file  name,
'"OutputStream"  is  used  to  create  such  a  file  and is  then  set to
'"FileSpec". If not, every variables remain unchanged.
Private Sub SaveFileAsHex(OutputStream, FileSpec, OverWrite As Boolean)
    Dim i As Long
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Dim FileId As Long
    Dim Buffer As Byte
    Dim BufLen As Long
    'Check existence of file specified with "FileSpec"
    If FSO.FileExists(FileSpec) And Not OverWrite Then GoTo FileExists
    'Open file "FileSpec" in output mode (empty file)
    On Error GoTo NotFile
    FileId = FreeFile
    Open FileSpec For Output As FileId
    Close FileId
    'Open file "FileSpec" in binary mode
    On Error GoTo SaveErr
    BufLen = Len(Buffer)
    Open FileSpec For Random As FileId Len = BufLen
    For i = 1 To Len(OutputStream) Step 2
        Put FileId, (i - 1) / 2 + 1, CByte("&H" & Mid$(OutputStream, i, 2))
    Next
    Close FileId
    'Reset "OutputStream" to its original value
    OutputStream = FileSpec
Exit Sub
SaveErr:
FileExists:
    OutputStream = Null
NotFile:
End Sub

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.
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire Commentaires
lbastou
Messages postés
1
Date d'inscription
mercredi 1 mars 2006
Statut
Membre
Dernière intervention
28 mai 2007
28 mai 2007 à 20:25
SAlut a toi !! je cherhe le meme genre de code mais en C# pour intergrer ca dans un page ASP.net

Peut tu me répondre a lbastou@hotmail.fr

merci
cs_santiago69
Messages postés
91
Date d'inscription
jeudi 18 novembre 2004
Statut
Membre
Dernière intervention
17 décembre 2008
23 juin 2006 à 21:55
Salut Renfield,
"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
katsankat
Messages postés
571
Date d'inscription
vendredi 30 décembre 2005
Statut
Membre
Dernière intervention
12 juillet 2012
 3
23 juin 2006 à 18:55
Salut :)
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 :)
Renfield
Messages postés
17287
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
27 septembre 2021
 71
23 juin 2006 à 16:16
sympatique, ca a l'air pas mal fait

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
S'inscrire maintenant

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.

Du même auteur (cs_santiago69)