encoding - online - Base64 Encode String en VBScript

decode string

Question

Tengo un controlador de carga de servicio web que es un archivo de script de Windows (WSF), que incluye algunos archivos VBScript y JavaScript. Mi servicio web requiere que el mensaje entrante esté codificado en base64. Actualmente tengo una función de VBScript que hace esto, pero es muy ineficiente (requiere mucha memoria, principalmente debido a la concatenación de cadenas horrible de VBScripts)

[Aparte; Sí, he visto la última publicación de blog de Jeff . La concatenación está sucediendo en un bucle entre los mensajes que tienen un tamaño de 1.000 a 10.000 bytes.]

He intentado utilizar algunas rutinas de concatenación de cadenas personalizadas; uno usando una matriz y uno usando ADODB.Stream. Estos ayudan un poco, pero creo que sería más útil si tuviera otra forma de codificar el mensaje en lugar de hacerlo a través de mi propia función VBS.

¿Hay alguna otra forma de codificar mi mensaje, preferiblemente usando métodos nativos de Windows?

Answer 1

Así que tengo otro ejemplo completo de codificador y decodificador:

Encoder:

'' 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

Descifrador:

'' 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

Answer 2

Este es un ejemplo de decodificación que no usa el objeto 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==

Answer 3

Es posible codificar base64 en vbscript puro sin ADODB.Stream y MSXml2.DOMDocument.

por ejemplo:

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

Si hay caracteres anchos ( AscW (c)> 255 o <0 ) en su cadena, puede convertirlos a utf-8 antes de la llamada btoa.

la conversión de utf-8 también se puede escribir en vbscript puro.

Answer 4

Esta respuesta mejora la gran respuesta de Patrick Cuff en que agrega soporte para codificaciones UTF-8 y UTF-16 LE ("Unicode"). (Además, el código está simplificado).

Ejemplos:

'' 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

Answer 5

Originalmente estaba usando un código VBScript de Antonin Foller: Base64 Encode VBS Function y Base64 Decode VBS Function .

Al buscar en el sitio de Antonin, vi que tenía un código para la codificación imprimible entre comillas, utilizando el objeto CDO.Message , así que lo intenté.

Finalmente, porté el código mencionado en la respuesta de Mark a VBScript (también usé algún código de esta pregunta SO), y usé las funciones Stream___StringToBinary y Stream_BinaryToString del sitio de Antonin para obtener funciones que usaban codificación MSXML.

Ejecuté una prueba rápida para medir el tiempo de codificación de un mensaje de 1.500 caracteres (el tamaño promedio de mensaje que necesito enviar a mi servicio web) en los cuatro métodos:

• Native VBScript (VBScript)
• Quoted Printable, utilizando CDO.Message (QP)
• Presupuesto binario imprimible, utilizando CDO.Message (QP binario)
• MSXML / ADODB.Stream (MSXML)

Aquí están los resultados:

Iterations : 10,000 Message Size : 1,500 +-------------+-----------+ + Method | Time (ms) + +-------------+-----------+ | VBScript | 301,391 | +-------------+-----------+ | QP | 12,922 | +-------------+-----------+ | QP (Binary) | 13,953 | +-------------+-----------+ | MSXML | 3,312 | +-------------+-----------+

También supervisé la utilización de la memoria (uso de Mem para el proceso cscript.exe en el Administrador de tareas de Windows) mientras se ejecutaba la prueba. No tengo ningún número en bruto, pero la utilización de la memoria para las soluciones imprimibles y MSXML citadas estaba debajo de la solución de VBScript (7,000K para el primero, alrededor de 16,000K para VBScript).

Decidí ir con la solución MSXML para mi controlador. Para los interesados, aquí está el código que estoy usando:

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