Base64 Encode String en VBScript

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?

    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 algún código para la encoding 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 utilicé las funciones Stream___StringToBinary y Stream_BinaryToString del sitio de Antonin para obtener funciones que usaban encoding MSXML.

    Ejecuté una prueba rápida para medir el tiempo de encoding 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:

     Iteraciones: 10,000
     Tamaño del mensaje: 1,500
    
     + ------------- + ----------- +
     + Método |  Tiempo (ms) + 
     + ------------- + ----------- +
     |  VBScript |  301,391 |
     + ------------- + ----------- +
     |  QP |  12,922 |
     + ------------- + ----------- +
     |  QP (binario) |  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 sin formato, pero la utilización de la memoria para las soluciones imprimibles y MSXML entre comillas 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 

    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 

    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 

    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.

    Este es un ejemplo de deencoding 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==