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