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
|
<html>
<head>
<SCRIPT LANGUAGE="VBScript">
Function Base64Encode(inData)
'rfc1521
'2001 Antonin Foller, Motobit Software, http://Motobit.cz
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim cOut, sOut, I
'For each group of 3 bytes
For I = 1 To Len(inData) Step 3
Dim nGroup, pOut, sGroup
'Create one long from this 3 bytes.
nGroup = &H10000 * Asc(Mid(inData, I, 1)) + &H100 * MyASC(Mid(inData, I + 1, 1)) + MyASC(Mid(inData, I + 2, 1))
'Oct splits the long To 8 groups with 3 bits
nGroup = Oct(nGroup)
'Add leading zeros
nGroup = String(8 - Len(nGroup), "0") & nGroup
'Convert To base64
pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)
'Add the part To OutPut string
sOut = sOut + pOut
'Add a new line For Each 76 chars In dest (76*3/4 = 57)
If (I + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf
Next
Select Case Len(inData) Mod 3
Case 1: '8 bit final
sOut = Left(sOut, Len(sOut) - 2) + "=="
Case 2: '16 bit final
sOut = Left(sOut, Len(sOut) - 1) + "="
End Select
Base64Encode = sOut
End Function
Function MyASC(OneChar)
If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
End Function
'Conversion base64 MSXML2.DOMDocument.4.0
Function Convert64XML(cheminFic)
Dim Fso
Set Fso = CreateObject("Scripting.FileSystemObject")
Set LOGfileName = Fso.OpenTextFile("c:\logconvert64XML.txt", 2)
MsgBox "Convert64XML:" & cheminFic
Set objXMLDoc = CreateObject("MSXML2.DOMDocument.4.0")
'The root node itslef will contain the base64 encoded data
objXMLDoc.loadXML "<Base64Data />"
Const ForReading = 1
Dim oFso, f
Set oFso = CreateObject("Scripting.FileSystemObject")
Set f = oFso.OpenTextFile(cheminFic, ForReading, True)
set oElement = objXMLDoc.documentElement
oElement.dataType = "bin.base64"
Dim s
Dim ligne
while Not f.AtEndOfStream
ligne = f.ReadLine
s = s& ligne
Wend
oElement.nodeTypedValue = Base64Encode(s)
ReadBinFileDom = objXMLDoc.Text
LOGfileName.write(ReadBinFileDom)
msgbox "ReadBinFileDom:" & ReadBinFileDom
LOGfileName.close()
End Function
</script>
</head>
<body>
<FORM NAME="Feuille1">
<INPUT TYPE="Button" NAME="Bouton1" VALUE="XML">
<SCRIPT FOR="Bouton1" EVENT="onClick" LANGUAGE="VBScript">
Convert64XML("c:\led-r.png")
</SCRIPT>
</FORM>
</body>
</html> |
Partager