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==" |
