bonjour,

une variation sur un thème déjà abordé mais cette fois-ci avec des composants COM classiques (ADO.Stream et Microsoft.XMLDOM)
un peu plus rapide surtout en encodage puisqu'il n'y a pas de code managé.
l'originalité du code est qu'à la différence de 99% des exemples que vous trouverez sur le net qui se contentent de cibler les fichiers binaires, cette classe accepte également en entrée comme en sortie les tableaux binaires byte()

Vbscript a la particularité, peu courante pour un langage, de pouvoir référencer des types de variable autres que le type Variant mais qu'il est par ailleurs incapable de manipuler directement
en revanche, ces variables peuvent être passées sans problème à des composants COM qui peuvent attendre ce type de données

ci-dessous la classe avec un exemple de décodage/encodage d'une chaine base64

Code :Sélectionner tout -Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
Class cBase64
' encode64/decode64 = (fichier binaire|byte()) <-> chaine base64
' après instanciation, la propriété par défaut Statut renseigne sur la réussite de celle-ci
 
' deux méthodes (syntaxe)
' size = .encode64(bin,data64)
' bin est, soit le nom d'une variable tableau byte, soit une chaine contenant un nom complet de fichier
' la chaine au format base64 sera dispo dans la variable data64 vide passée en référence
 
' size = .decode64(data64,bin)
' data64 : chaine au format base64 à décoder
' bin est, soit le nom d'une variable tableau byte, soit une chaine contenant un nom complet de fichier
 
' les deux méthodes renvoient la taille en octets du résultat
' soit une chaine base64 pour encode64, un tableau byte ou fichier pour decode64
' -1 en cas d'échec
 
' deux propriétés
' Statut (default) :
' 0 : succes
' 1 : ADOStream indisponible
' 2 : XLMDOM indisponible
' 3 : les deux composants sont indisponibles
 
' aByte : renvoie une variable tableau byte() destinée à recevoir le contenu binaire décodé de la chaine base64
 
Private stm,xml,elx
Private iRep,iSize,i
Private Sub Class_Initialize()
  iRep = 0
  On Error Resume Next
  Set stm = CreateObject("ADODB.Stream")
  If Not IsObject(stm) Then iRep = 1
    Set xml = CreateObject("Microsoft.XMLDOM")
    If Not IsObject(xml) Then
      iRep = iRep + 2
    Else
      Set elx = xml.createElement("tmp")
      elx.DataType = "bin.base64"
    End If
  On Error GoTo 0
End Sub
Public Default Property Get Statut
	Statut = iRep
End Property
Public Property Get aByte
  With stm
   .Open
   .Type = 1
   elx.Text = "AA=="
   .Write elx.NodeTypedValue
   .Position = 0
   aByte = .Read
   .Close
  End With
End Property
Public Function encode64(bin,ByRef data64)
  iSize = -1  ' par defaut
  For i = 0 to 0 ' permet de sortir de select case
    Select Case VarType(bin)
    Case 8,8209  ' chaine nom de fichier ou byte()
      On Error Resume Next
      With stm	
        .Open
        .Type= 1 ' TypeBinary
        If VarType(bin) = 8 Then
          .LoadFromFile bin
	  If Err.Number <> 0 Then
	    MsgBox "Erreur, le fichier """ & bin & """ est introuvable"
  	    .Close
  	    On Error GoTo 0
	    Exit For  			
  	  End If
        Else
          .Write bin
        End If
        .Position = 0
        elx.NodeTypedValue = .Read
        data64 = Replace(elx.Text,Chr(10),"") ' supprime le formatage MIME
        iSize = Len(data64) ' maj taille de la chaine base64
  	.Close
     End With
     On Error GoTo 0
     Case Else
       MsgBox "Encodage en base64 impossible, la variable d'entrée n'est ni un nom de fichier, ni une variable byte()"
     End Select
   Next
   encode64 = iSize
End Function
 
Public Function decode64(data64,bin)
  iSize = -1
  For i = 0 to 0 ' permet de sortir de select case
    Select Case VarType(bin)
    Case 8,8209  ' chaine nom de fichier ou byte()
    On Error Resume Next
    With stm
      elx.Text = data64
      If Err.Number = &H80004005 Then
        MsgBox "Erreur, la variable d'entrée ne contient pas de données au format base64"
	On Error GoTo 0
        Exit For
      End If
      .Open
      .Type= 1 ' TypeBinary
      .Write elx.NodeTypedValue
      If VarType(bin) = 8 Then		
      .SaveToFile bin,2  'adSaveCreateOverWrite
  	If Err.Number <> 0 Then
          MsgBox "Erreur, la syntaxe de la variable fichier """ & bin & """ n'est pas correcte"
	  On Error GoTo 0
	  Exit For
        End If
      Else
        .Position = 0
        bin = .Read	
      End If
      iSize = .Size
      .Close
    End With
    On Error GoTo 0
  Case Else
    MsgBox "Décodage des données base64 impossible, la variable de sortie n'est ni un nom de fichier, ni une variable byte()"
  End Select
  Next
  decode64 = iSize
End Function
End Class
 
Dim outbin,sData64
Set base64 = New cBase64
If base64.Statut = 0 Then
  'outbin = "fichier.bin"  ' variante avec fichier
  outbin = base64.aByte
  iRep = base64.decode64(dataDlg,outbin)
  If VarType(outbin) = 8209 Then MsgBox TypeName(outbin) & " " & UBound(outbin) & " " & iRep
  iRep = base64.encode64(outbin,sData64)
  MsgBox iRep
  CreateObject("WScript.Shell").Popup sData64
End If
 
Const dataDlg = "AQD//wAAAAAAAAAAwAjIgAwACgAKAHIBqgAAAAAAQgB1AGkAbABkAEQAbABnAEYAcgBvAG0AQgBpAG4AIABiAHkAIABvAG0AZQBuADkAOQA5ACAALQAgAGgAdAB0AHAAcwA6AC8ALwBvAG0AZQBuADkAOQA5AC4AZABlAHYAZQBsAG8AcABwAGUAegAuAGMAbwBtAAAACQAAAAAAUwBFAEcATwBFACAAVQBJAAAAAAAAAAAAAAAAAAAAAVA8ATEANAANAGUAAAD//4AAJgBDAGgAbwBpAHMAaQByAC4ALgAuAHwAMAB8AHwAfAB8AHwARgBpAGMAaABpAGUAcgBzACAAYgBpAG4AYQBpAHIAZQBzACAAKAAqAC4AYgBpAG4AKQB8ACoALgBiAGkAbgB8AFQAbwB1AHMAIABmAGkAYwBoAGkAZQByAHMAIAAoACoALgAqACkAfAAqAC4AKgAAAAAAAAAAAAAAAAAAAAAAAVA8AU8ANAANAGYAAAD//4AAQwAmAGgAbwBpAHMAaQByAC4ALgAuAHwAMQB8ADEAMQAyAAAAAAAAAAAAAAAAAAAAAACBUAoAUAAwAQsAcAAAAP//gQAAAAAAAAAAAAAAAAAAAIFQCgBuAF0ACwBxAAAA//+BAAAAAAAAAAAAAAAAAAAAAVDQAJoANAANAHgAAAD//4AAQQAmAHAAcABsAGkAcQB1AGUAcgAAAAAAAAAAAAAAAAABAAFQBgGaADQADQABAAAA//+AACYATwBLAAAAAAAAAAAAAAAAAAAAAAABUDwBmgA0AA0AAgAAAP//gAAmAEEAbgBuAHUAbABlAHIAAAAAAAAAAAAAAAAAAAACUAoAFAC8AAoAFAAAAP//ggBVAHQAaQBsAGkAdABhAGkAcgBlACAAZABlACAAYwBvAG4AdgBlAHIAcwBpAG8AbgAgAGQAZQAgAHIAZQBzAG8AdQByAGMAZQBzACAAYgBpAG4AYQBpAHIAZQBzACAAKAB4AEcAVQBJAEMATwBNACAAdgAgADIALgAwACkAAAAAAAAAAAAAAAAAAAiAWAoAMgAwAQsAbwAAAP//gQAAAAAAAAAAAAAAAAAAAAJQCgAoAFAACgAVAAAA//+CAEYAaQBjAGgAaQBlAHIAIAByAGUAcwBvAHUAcgBjAGUAIABiAGkAbgBhAGkAcgBlACAAOgAAAAAAAAAAAAAAAAAAAAJQCgBGAGgACgAWAAAA//+CAEYAaQBjAGgAaQBlAHIAIABzAGMAcgBpAHAAdAAgAOAAIABjAHIA6QBlAHIAIABvAHUAIABtAG8AZABpAGYAaQBlAHIAIAA6AAAAAAAAAAAAAAAAAAAAAlAKAGQAZAAJABcAAAD//4IATgBvAG0AIABkAGUAIABsAGEAIABjAG8AbgBzAHQAYQBuAHQAZQAgAHIAZQBzAG8AdQByAGMAZQAgADoAAAAAAA=="