Cadena de codificación Base64 en VBScript
https://stackoverflow.com/questions/496751
italiano
english
français
española
中国
日本の
العربية
Deutsch
한국어
Português
RussianPregunta
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 VBScript que hace esto, pero es muy ineficiente (uso intensivo de memoria, principalmente debido a la horrible concatenación de cadenas VBScripts)
[Aparte; Sí, he visto la última publicación de blog de Jeff . La concatenación está ocurriendo en un bucle a través de mensajes que tienen un tamaño de 1,000 a 10,000 bytes.]
He intentado usar algunas rutinas de concatenación de cadenas personalizadas; uno con una matriz y otro con ADODB.Stream. Esto ayuda un poco, pero creo que ayudaría más si tuviera otra forma de codificar el mensaje en lugar de a través de mi propia función VBS.
¿Hay alguna otra forma de codificar mi mensaje, preferiblemente usando métodos nativos de Windows?
Solución
Originalmente estaba usando algún código VBScript de Antonin Foller: Función Base64 Encode VBS y Función Base64 Decode VBS .
Al buscar en el sitio de Antonin, vi que tenía un código para codificación imprimible citada, utilizando el CDO.Message objeto , 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é la Stream___StringToBinary y Stream_BinaryToString funciones del sitio de Antonin para obtener funciones que utilizan codificación MSXML.
Realicé 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:
- VBScript nativo (VBScript)
- Citado imprimible, utilizando CDO.Message (QP)
- Binario imprimible citado, usando CDO.Message (QP Binary)
- 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 memoria 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 por debajo de la solución VBScript (7,000 K para el primero, alrededor de 16,000 K para VBScript).
Decidí ir con la solución MSXML para mi controlador. Para aquellos 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
Otros consejos
Esta respuesta mejora en 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á optimizado).
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
Así que tengo otro ejemplo completo de codificador y decodificador:
Codificador:
' 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
Decodificador:
' 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
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 convertirlo a utf-8 antes de llamar a btoa.
la conversión utf-8 también se puede escribir en puro vbscript.
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==
Para que pueda usar este objeto para codificar o decodificar Base_64 = CreateObject("Msxml2.DOMDocument.3.0")
Y use Array para codificar o decodificar & amp; Mi código también es compatible con UTF-8. (Decodificar).
Enlace de ayuda = VBS_Array
Aquí está mi camino = >
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
Licenciado bajo: CC-BY-SA con atribución
No afiliado a StackOverflow
