Base64 Encode String in VBScript
Frage
Ich habe einen Web-Service-Last-Treiber, der eine Windows Script-Datei (WSF) ist, dass einige VBScript und JavaScript-Dateien enthält. Mein Web-Service erfordert, dass die eingehende Nachricht wird Base64 codiert. Im Moment habe ich eine VBScript-Funktion, das dies tut, aber es ist sehr ineffizient (speicherintensiv, vor allem aufgrund VBScripts schrecklich String-Verkettung)
[Abgesehen; Ja, ich habe gesehen Jeffs neueste Blog-Post . Die Verkettung wird in einer Schleife über Meldungen geschieht, die 1000 's bis 10.000 der Bytes groß sind.]
Ich habe versucht, einige benutzerdefinierte String-Verkettung Routinen; ein eine Anordnung und ein unter Verwendung ADODB.Stream verwenden. Diese helfen, ein wenig, aber ich denke, es wäre mehr zu helfen, wenn ich die Nachricht eine andere Art und Weise habe die Codierung anstatt über meine eigene VBS-Funktion.
Gibt es eine andere Möglichkeit, meine Botschaft kodiert, preferebly native Windows-Methoden verwenden?
Lösung
Ich war ursprünglich mit einigem VBScript-Code von Antonin Foller: Base64 Encode VBS Funktion und Base64 Decode VBS Funktion .
Antonin Website Suchen, ich sah er für , mit der Objekt CDO.Message, also versuchte ich das.
Schließlich habe ich den Code portiert in Mark Antwort auf VBScript erwähnt (verwendet auch einige Code von diese Frage SO), und verwendet, um die Stream___StringToBinary und Stream_BinaryToString Funktionen von Antonin Website erhalten Funktionen, die MSXML-Codierung verwendet wird.
lief ich einen schnellen Test, um die Codierung Zeit für eine 1.500 Zeichen-Nachricht (die durchschnittliche Nachrichtengröße ich auf meinen Web-Service senden muß) über alle vier Methoden zur Messung:
- Native VBScript (VBScript)
- Quoted Printable, mit CDO.Message (QP)
- Quoted Printable Binary, mit CDO.Message (QP Binary)
- MSXML / ADODB.Stream (MSXML)
Hier sind die Ergebnisse:
Iterations : 10,000 Message Size : 1,500 +-------------+-----------+ + Method | Time (ms) + +-------------+-----------+ | VBScript | 301,391 | +-------------+-----------+ | QP | 12,922 | +-------------+-----------+ | QP (Binary) | 13,953 | +-------------+-----------+ | MSXML | 3,312 | +-------------+-----------+
ich überwachte auch die Speicherauslastung (Mem Usage für den cscript.exe Prozess im Windows Task-Manager), während der Test ausgeführt wurde. Ich habe keine rohen Zahlen, aber die Speicherauslastung für beide die quoted-printable und MSXML Lösungen war unter der VBScript-Lösung (7,000K für die ehemaligen, um 16,000K für VBScript).
habe ich beschlossen, mit der MSXML Lösung für meinen Fahrer zu gehen. Für Interessenten, hier ist der Code, den ich mit:
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
Andere Tipps
Diese Antwort verbessert auf Patrick Cuff die große Antwort , dass es fügt Unterstützung für UTF-8 und UTF-16 LE-Codierungen ( "Unicode"). (Zusätzlich wird der Code rationalisiert).
Beispiele:
' 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
Also ich habe ein anderes vollständiges Beispiel von Encoder und Decoder:
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
Decoder:
' 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 ist möglich, base64 in reiner Vbscript ohne ADODB.Stream und MSXml2.DOMDocument zu kodieren.
Beispiel:
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
Wenn es große Zeichen ( AscW (c)> 255 oder <0 ) in der Zeichenfolge, können Sie es auf UTF-8 konvertieren, bevor Anruf btoa.
utf-8 convertion kann auch in reinem Vbscript geschrieben werden.
Dies ist ein Dekodierungs Beispiel, das nicht das ADODB-Objekt nicht verwendet.
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==
So Sie können dieses Objekt verwenden zu verschlüsseln oder Decode Base_64 = CreateObject("Msxml2.DOMDocument.3.0")
Und Verwenden Array zu kodieren oder zu dekodieren und auch mein Code unterstützt UTF-8. (Decode).
Hilfe Link = VBS_Array
Hier ist My Way =>
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