web-dev-qa-db-fra.com

Base64 Encode String dans VBScript

J'ai un pilote de chargement de service Web qui est un fichier de script Windows (WSF), qui comprend des fichiers VBScript et JavaScript. Mon service Web nécessite que le message entrant soit codé en base64. J'ai actuellement une fonction VBScript qui fait cela, mais elle est très inefficace (mémoire intensive, principalement en raison de la concaténation de chaînes horrible VBScripts)

[À part; Oui, j'ai vu le dernier article de blog de Jeff . La concaténation se produit en boucle entre des messages de 1 000 à 10 000 octets.]

J'ai essayé d'utiliser des routines de concaténation de chaînes personnalisées; un en utilisant un tableau et un en utilisant ADODB.Stream. Cela aide un peu, mais je pense que cela aiderait davantage si j'avais une autre façon d'encoder le message plutôt que via ma propre fonction VBS.

Existe-t-il un autre moyen d'encoder mon message, de préférence en utilisant des méthodes Windows natives?

encodingvbscriptbase64wsh
24
Patrick Cuff

J'utilisais à l'origine du code VBScript d'Antonin Foller: Fonction VBS Encodage Base64 et Fonction VBS Décodage Base64 .

En cherchant sur le site d'Antonin, j'ai vu qu'il avait du code pour cité le codage imprimable, en utilisant l'objet CDO.Message , alors j'ai essayé.

Enfin, j'ai porté le code mentionné dans la réponse de Mark à VBScript (également utilisé du code de this SO question), et utilisé le Stream ___ StringToBinary et Stream_BinaryToString fonctions du site d'Antonin pour obtenir des fonctions utilisant le codage MSXML.

J'ai effectué un test rapide pour mesurer le temps d'encodage d'un message de 1 500 caractères (la taille moyenne des messages que je dois envoyer à mon service Web) à travers les quatre méthodes:

  • VBScript natif (VBScript)
  • Imprimable cité, en utilisant CDO.Message (QP)
  • Binaire imprimable cité, à l'aide de CDO.Message (binaire QP)
  • MSXML/ADODB.Stream (MSXML)

Voici les résultats:

 Itérations: 10 000 
 Taille du message: 1 500 
 
 + ------------- + -------- --- + 
 + Méthode | Temps (ms) + 
 + ------------- + ----------- + 
 | VBScript | 301 391 | 
 + ------------- + ----------- + 
 | QP | 12 922 | 
 + ------------- + ----------- + 
 | QP (binaire) | 13 953 | 
 + ------------- + ----------- + 
 | MSXML | 3,312 | 
 + ------------- + ----------- +

J'ai également surveillé l'utilisation de la mémoire (utilisation Mem pour le processus cscript.exe dans le Gestionnaire des tâches de Windows) pendant l'exécution du test. Je n'ai pas de chiffres bruts, mais l'utilisation de la mémoire pour les solutions imprimables et MSXML citées était inférieure à la solution VBScript (7 000 K pour la première, environ 16 000 K pour VBScript).

J'ai décidé d'utiliser la solution MSXML pour mon pilote. Pour ceux qui sont intéressés, voici le code que j'utilise:

base64.vbs
Function Base64Encode(sText)
    Dim oXML, oNode

    Set oXML = CreateObject("Msxml2.DOMDocument.3.0")
    Set oNode = oXML.CreateElement("base64")
    oNode.dataType = "bin.base64"
    oNode.nodeTypedValue =Stream_StringToBinary(sText)
    Base64Encode = oNode.text
    Set oNode = Nothing
    Set oXML = Nothing
End Function

Function Base64Decode(ByVal vCode)
    Dim oXML, oNode

    Set oXML = CreateObject("Msxml2.DOMDocument.3.0")
    Set oNode = oXML.CreateElement("base64")
    oNode.dataType = "bin.base64"
    oNode.text = vCode
    Base64Decode = Stream_BinaryToString(oNode.nodeTypedValue)
    Set oNode = Nothing
    Set oXML = Nothing
End Function

'Stream_StringToBinary Function
'2003 Antonin Foller, http://www.motobit.com
'Text - string parameter To convert To binary data
Function Stream_StringToBinary(Text)
  Const adTypeText = 2
  Const adTypeBinary = 1

  'Create Stream object
  Dim BinaryStream 'As New Stream
  Set BinaryStream = CreateObject("ADODB.Stream")

  'Specify stream type - we want To save text/string data.
  BinaryStream.Type = adTypeText

  'Specify charset For the source text (unicode) data.
  BinaryStream.CharSet = "us-ascii"

  'Open the stream And write text/string data To the object
  BinaryStream.Open
  BinaryStream.WriteText Text

  'Change stream type To binary
  BinaryStream.Position = 0
  BinaryStream.Type = adTypeBinary

  'Ignore first two bytes - sign of
  BinaryStream.Position = 0

  'Open the stream And get binary data from the object
  Stream_StringToBinary = BinaryStream.Read

  Set BinaryStream = Nothing
End Function

'Stream_BinaryToString Function
'2003 Antonin Foller, http://www.motobit.com
'Binary - VT_UI1 | VT_ARRAY data To convert To a string 
Function Stream_BinaryToString(Binary)
  Const adTypeText = 2
  Const adTypeBinary = 1

  'Create Stream object
  Dim BinaryStream 'As New Stream
  Set BinaryStream = CreateObject("ADODB.Stream")

  'Specify stream type - we want To save binary data.
  BinaryStream.Type = adTypeBinary

  'Open the stream And write binary data To the object
  BinaryStream.Open
  BinaryStream.Write Binary

  'Change stream type To text/string
  BinaryStream.Position = 0
  BinaryStream.Type = adTypeText

  'Specify charset For the output text (unicode) data.
  BinaryStream.CharSet = "us-ascii"

  'Open the stream And get text/string data from the object
  Stream_BinaryToString = BinaryStream.ReadText
  Set BinaryStream = Nothing
End Function
47
Patrick Cuff

Cette réponse améliore sur la grande réponse de Patrick Cuff en ce qu'elle ajoute le support pour UTF- 8 et encodages UTF-16 LE ("Unicode"). (De plus, le code est simplifié).

Exemples:

' Base64-encode: from UTF-8-encoded bytes.
Base64Encode("Motörhead", False) ' "TW90w7ZyaGVhZA=="

' Base64-encode: from UTF-16 LE-encoded bytes.
Base64Encode("Motörhead", True) ' "TQBvAHQA9gByAGgAZQBhAGQA"


' Base64-decode: back to a VBScript string via UTF-8.
Base64Decode("TW90w7ZyaGVhZA==", False) ' "Motörhead"

' Base64-decode: back to a VBScript string via UTF-16 LE.
Base64Decode("TQBvAHQA9gByAGgAZQBhAGQA", True) ' "Motörhead"

' Base64-encodes the specified string.
' Parameter fAsUtf16LE determines how the input text is encoded at the
' byte level before Base64 encoding is applied.
' * Pass False to use UTF-8 encoding.
' * Pass True to use UTF-16 LE encoding.
Function Base64Encode(ByVal sText, ByVal fAsUtf16LE)

    ' Use an aux. XML document with a Base64-encoded element.
    ' Assigning the byte stream (array) returned by StrToBytes() to .NodeTypedValue
    ' automatically performs Base64-encoding, whose result can then be accessed
    ' as the element's text.
    With CreateObject("Msxml2.DOMDocument").CreateElement("aux")
        .DataType = "bin.base64"
        if fAsUtf16LE then
            .NodeTypedValue = StrToBytes(sText, "utf-16le", 2)
        else
            .NodeTypedValue = StrToBytes(sText, "utf-8", 3)
        end if
        Base64Encode = .Text
    End With

End Function


' Decodes the specified Base64-encoded string. 
' If the decoded string's original encoding was:
' * UTF-8, pass False for fIsUtf16LE.
' * UTF-16 LE, pass True for fIsUtf16LE.
Function Base64Decode(ByVal sBase64EncodedText, ByVal fIsUtf16LE)

    Dim sTextEncoding
    if fIsUtf16LE Then sTextEncoding = "utf-16le" Else sTextEncoding = "utf-8"

    ' Use an aux. XML document with a Base64-encoded element.
    ' Assigning the encoded text to .Text makes the decoded byte array
    ' available via .nodeTypedValue, which we can pass to BytesToStr()
    With CreateObject("Msxml2.DOMDocument").CreateElement("aux")
        .DataType = "bin.base64"
        .Text = sBase64EncodedText
        Base64Decode = BytesToStr(.NodeTypedValue, sTextEncoding)
    End With

End Function


' Returns a binary representation (byte array) of the specified string in
' the specified text encoding, such as "utf-8" or "utf-16le".
' Pass the number of bytes that the encoding's BOM uses as iBomByteCount;
' pass 0 to include the BOM in the output.
function StrToBytes(ByVal sText, ByVal sTextEncoding, ByVal iBomByteCount)

    ' Create a text string with the specified encoding and then
    ' get its binary (byte array) representation.
    With CreateObject("ADODB.Stream")
        ' Create a stream with the specified text encoding...
        .Type = 2  ' adTypeText
        .Charset = sTextEncoding
        .Open
        .WriteText sText
        ' ... and convert it to a binary stream to get a byte-array 
        ' representation.
        .Position = 0 
        .Type = 1  ' adTypeBinary
        .Position = iBomByteCount ' skip the BOM
        StrToBytes = .Read
        .Close
    End With 

end function

' Returns a string that corresponds to the specified byte array, interpreted
' with the specified text encoding, such as "utf-8" or "utf-16le".
function BytesToStr(ByVal byteArray, ByVal sTextEncoding)

    If LCase(sTextEncoding) = "utf-16le" then
        ' UTF-16 LE happens to be VBScript's internal encoding, so we can
        ' take a shortcut and use CStr() to directly convert the byte array
        ' to a string.
        BytesToStr = CStr(byteArray)
    Else ' Convert the specified text encoding to a VBScript string.
        ' Create a binary stream and copy the input byte array to it.
        With CreateObject("ADODB.Stream")
            .Type = 1 ' adTypeBinary
            .Open
            .Write byteArray
            ' Now change the type to text, set the encoding, and output the 
            ' result as text.
            .Position = 0
            .Type = 2 ' adTypeText
            .CharSet = sTextEncoding
            BytesToStr = .ReadText
            .Close
        End With
    End If

end function
7
mklement0

J'ai donc un autre exemple complet d'encodeur et de décodeur:

Encodeur:

' This script reads jpg picture named SuperPicture.jpg, converts it to base64
' code using encoding abilities of MSXml2.DOMDocument object and saves
' the resulting data to encoded.txt file

Option Explicit

Const fsDoOverwrite     = true  ' Overwrite file with base64 code
Const fsAsASCII         = false ' Create base64 code file as ASCII file
Const adTypeBinary      = 1     ' Binary file is encoded

' Variables for writing base64 code to file
Dim objFSO
Dim objFileOut

' Variables for encoding
Dim objXML
Dim objDocElem

' Variable for reading binary picture
Dim objStream

' Open data stream from picture
Set objStream = CreateObject("ADODB.Stream")
objStream.Type = adTypeBinary
objStream.Open()
objStream.LoadFromFile("SuperPicture.jpg")

' Create XML Document object and root node
' that will contain the data
Set objXML = CreateObject("MSXml2.DOMDocument")
Set objDocElem = objXML.createElement("Base64Data")
objDocElem.dataType = "bin.base64"

' Set binary value
objDocElem.nodeTypedValue = objStream.Read()

' Open data stream to base64 code file
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFileOut = objFSO.CreateTextFile("encoded.txt", fsDoOverwrite, fsAsASCII)

' Get base64 value and write to file
objFileOut.Write objDocElem.text
objFileOut.Close()

' Clean all
Set objFSO = Nothing
Set objFileOut = Nothing
Set objXML = Nothing
Set objDocElem = Nothing
Set objStream = Nothing

Décodeur:

' This script reads base64 encoded picture from file named encoded.txt,
' converts it in to back to binary reprisentation using encoding abilities
' of MSXml2.DOMDocument object and saves data to SuperPicture.jpg file

Option Explicit

Const foForReading          = 1 ' Open base 64 code file for reading
Const foAsASCII             = 0 ' Open base 64 code file as ASCII file
Const adSaveCreateOverWrite = 2 ' Mode for ADODB.Stream
Const adTypeBinary          = 1 ' Binary file is encoded

' Variables for reading base64 code from file
Dim objFSO
Dim objFileIn
Dim objStreamIn

' Variables for decoding
Dim objXML
Dim objDocElem

' Variable for write binary picture
Dim objStream

' Open data stream from base64 code filr
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFileIn   = objFSO.GetFile("encoded.txt")
Set objStreamIn = objFileIn.OpenAsTextStream(foForReading, foAsASCII)

' Create XML Document object and root node
' that will contain the data
Set objXML = CreateObject("MSXml2.DOMDocument")
Set objDocElem = objXML.createElement("Base64Data")
objDocElem.DataType = "bin.base64"

' Set text value
objDocElem.text = objStreamIn.ReadAll()

' Open data stream to picture file
Set objStream = CreateObject("ADODB.Stream")
objStream.Type = adTypeBinary
objStream.Open()

' Get binary value and write to file
objStream.Write objDocElem.NodeTypedValue
objStream.SaveToFile "SuperPicture.jpg", adSaveCreateOverWrite

' Clean all
Set objFSO = Nothing
Set objFileIn = Nothing
Set objStreamIn = Nothing
Set objXML = Nothing
Set objDocElem = Nothing
Set objStream = Nothing
5
rodnower

Il est possible de coder base64 en vbscript pur sans ADODB.Stream et MSXml2.DOMDocument.

par exemple:

Function btoa(sourceStr)
    Dim i, j, n, carr, rarr(), a, b, c
    carr = Array("A", "B", "C", "D", "E", "F", "G", "H", _
            "I", "J", "K", "L", "M", "N", "O" ,"P", _
            "Q", "R", "S", "T", "U", "V", "W", "X", _
            "Y", "Z", "a", "b", "c", "d", "e", "f", _
            "g", "h", "i", "j", "k", "l", "m", "n", _
            "o", "p", "q", "r", "s", "t", "u", "v", _
            "w", "x", "y", "z", "0", "1", "2", "3", _
            "4", "5", "6", "7", "8", "9", "+", "/")
    n = Len(sourceStr)-1
    ReDim rarr(n\3)
    For i=0 To n Step 3
        a = AscW(Mid(sourceStr,i+1,1))
        If i < n Then
            b = AscW(Mid(sourceStr,i+2,1))
        Else
            b = 0
        End If
        If i < n-1 Then
            c = AscW(Mid(sourceStr,i+3,1))
        Else
            c = 0
        End If
        rarr(i\3) = carr(a\4) & carr((a And 3) * 16 + b\16) & carr((b And 15) * 4 + c\64) & carr(c And 63)
    Next
    i = UBound(rarr)
    If n Mod 3 = 0 Then
        rarr(i) = Left(rarr(i),2) & "=="
    ElseIf n Mod 3 = 1 Then
        rarr(i) = Left(rarr(i),3) & "="
    End If
    btoa = Join(rarr,"")
End Function


Function char_to_utf8(sChar)
    Dim c, b1, b2, b3
    c = AscW(sChar)
    If c < 0 Then
        c = c + &H10000
    End If
    If c < &H80 Then
        char_to_utf8 = sChar
    ElseIf c < &H800 Then
        b1 = c Mod 64
        b2 = (c - b1) / 64
        char_to_utf8 = ChrW(&HC0 + b2) & ChrW(&H80 + b1)
    ElseIf c < &H10000 Then
        b1 = c Mod 64
        b2 = ((c - b1) / 64) Mod 64
        b3 = (c - b1 - (64 * b2)) / 4096
        char_to_utf8 = ChrW(&HE0 + b3) & ChrW(&H80 + b2) & ChrW(&H80 + b1)
    Else
    End If
End Function

Function str_to_utf8(sSource)
    Dim i, n, rarr()
    n = Len(sSource)
    ReDim rarr(n - 1)
    For i=0 To n-1
        rarr(i) = char_to_utf8(Mid(sSource,i+1,1))
    Next
    str_to_utf8 = Join(rarr,"")
End Function

Function str_to_base64(sSource)
    str_to_base64 = btoa(str_to_utf8(sSource))
End Function

'test

msgbox btoa("Hello")   'SGVsbG8=
msgbox btoa("Hell")    'SGVsbA==

msgbox str_to_base64("中文한국어")  '5Lit5paH7ZWc6rWt7Ja0

S'il y a des caractères larges (AscW (c)> 255 ou <) dans votre chaîne, vous pouvez le convertir en utf-8 avant d'appeler btoa.

la conversion utf-8 peut également être écrite en pur vbscript.

3
cuixiping

Il s'agit d'un exemple de décodage qui n'utilise pas l'objet ADODB.

option explicit
dim inobj,outobj,infile,myname,state,rec,outfile,content,table(256),bits,c,x,outword
state = 0
const r64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
myname = wscript.scriptfullname
set inobj = createobject("Scripting.FileSystemObject")
set outobj = createobject("Scripting.FileSystemObject")
set infile = inobj.opentextfile(myname,1)
set outfile = outobj.createtextfile("q.png")
for x = 1 to 256 step 1
    table(x) = -1
next
for x = 1 to 64 step 1
    table(1+asc(mid(r64,x,1))) = x - 1
next
bits = 0
do until(infile.atendofstream)
    dim size
    rec = infile.readline
    if (state = 1) then 
        content = mid(rec,2)
        size = len(content)
        for x = 1 to size step 1
            c = table(1+asc(mid(content,x,1)))
            if (c <> -1) then
                if (bits = 0) then
                    outword = c*4
                    bits = 6
                elseif (bits = 2) then
                    outword = c+outword
                    outfile.write(chr(clng("&H" & hex(outword mod 256))))
                    bits = 0
                elseif (bits = 4) then
                    outword = outword + int(c/4)
                    outfile.write(chr(clng("&H" & hex(outword mod 256))))
                    outword = c*64
                    bits = 2
                else
                    outword = outword + int(c/16)
                    outfile.write(chr(clng("&H" & hex(outword mod 256))))
                    outword = c*16
                    bits = 4
                end if
            end if
        next
    end if
    if (rec = "'PAYLOAD") then
        state = 1
    end if
loop
infile.close
outfile.close
wscript.echo "q.png created"
wscript.quit
'PAYLOAD
'iVBORw0KGgoAAAANSUhEUgAAAD4AAAA+CAIAAAD8oz8TAAABoklEQVRo3u2awQrDMAxDl7H/
'/+Xu0EsgSDw7hRF7vWywpO0UW5acjOu6Xmde79ex1+f+GGPACfcqzePXdVvvts7iv6rx56Ou
'8FNYkgyZx9xzZ3TVHfg7VEHdR+o6ZsWV54O/yDvUQj2KzYyH5wof5f14fR97xdPrmjy1ArVQ
'55yteMYzEqma5B2qoM5VBK+OuXUrHutjJ8c59l4z/vV6Vv15PbOjiFRunB/rOcYgIz1jEPek
'nnh+rBPsiYbOaRu/DipzKrqkqNOJdgEIF3mNVLGa7jM9YSReg+t6U/UvFTYqmn13gGeUr9C1
'ul85rlCVgVTHnGeo2xGIdnT3PRR3vbUYhjAJqXxRHxTtslfsrxOe8aziWdlnAukRVPGmuX9P
'KnG0y9Wjv+71IPf8JEMIZxeP9ZHDkvO0z6XoXmlF1APTMIpR38R5qd8ZAa7gc76JaMl+ZwR4
'N0vdn6hRf89+ZwRIXZy/e473bks9sd9uterERvmbKP4end6cVlFRHt2n9mxTN9b3PTzfIco5
'4Ip9mGd1ud8bUriS3Oh6RuC318GofwHqKhl/Nn0DHQAAAABJRU5ErkJggg==
1
pizza

Vous pouvez donc utiliser cet objet pour coder ou décoder Base_64 = CreateObject("Msxml2.DOMDocument.3.0")

Et utilisez Array pour l'encoder ou le décoder et aussi mon code prend en charge UTF-8. (Decode).

Lien d'aide = VBS_Array

Voici ma voie =>

Function Base64Encode(sText)
 Set oNode = CreateObject("Msxml2.DOMDocument.3.0").CreateElement("base64")
 oNode.dataType = "bin.base64"
 oNode.nodeTypedValue =Stream_StringToBinary(sText)
 Base64Encode = oNode.text
 Set oNode = Nothing
End Function

Function Base64Decode(ByVal vCode)
 Set oNode = CreateObject("Msxml2.DOMDocument.3.0").CreateElement("base64")
 oNode.dataType = "bin.base64"
 oNode.text = vCode
 Base64Decode = Stream_BinaryToString(oNode.nodeTypedValue)
 Set oNode = Nothing
End Function

Function Stream_StringToBinary(Text)
 Set BinaryStream = CreateObject("ADODB.Stream")
 BinaryStream.Type = 2
' All Format =>  utf-16le - utf-8 - utf-16le
 BinaryStream.CharSet = "us-ascii"
 BinaryStream.Open
 BinaryStream.WriteText Text
 BinaryStream.Position = 0
 BinaryStream.Type = 1
 BinaryStream.Position = 0
 Stream_StringToBinary = BinaryStream.Read
 Set BinaryStream = Nothing
End Function

Function Stream_BinaryToString(Binary)
 Set BinaryStream = CreateObject("ADODB.Stream")
 BinaryStream.Type = 1
 BinaryStream.Open
 BinaryStream.Write Binary
 BinaryStream.Position = 0
 BinaryStream.Type = 2
 ' All Format =>  utf-16le - utf-8 - utf-16le
 BinaryStream.CharSet = "utf-8"
 Stream_BinaryToString = BinaryStream.ReadText
 Set BinaryStream = Nothing
End Function

''''''''''''''''''''''''''''''''''''''''''''''Testing'''''''''''''''''''''''''''''''''''''''''

arr=array("Hello","&Welcome","To My Program")
For Each Endcode In arr
 WSH.Echo Base64Encode(Endcode)
Next

arr=array("2LPZhNin2YU==","R29vZA==","QnkhIQ==")
For Each Decode In arr
 WSH.Echo Base64Decode(Decode)
Next
0
scientist_7