Classic ASP Base64 Encoding and Line Breaks - vbscript

I have been using the base64 encoding function from this answer (code is below)
https://stackoverflow.com/a/506992/510296
I noticed that it is wrapping lines of output after the 72nd character (which causes problems when I try to pass that encoded string to the eBay API).
I can remove the line breaks easily enough with replace(base64string, vblf, "") but wanted to ask if there is a proper way to prevent line breaks in the output.
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 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

Related

How to create UTF-16 file in VBScript?

My system is Window 10 English-US.
I need to write some non-printable ASCII characters to a text file. So for eg for the ASCII value of 28, I want to write \u001Cw to the file. I don't have to do anything special when coded in Java. Below is my code in VBS
Dim objStream
Set objStream = CreateObject("ADODB.Stream")
objStream.Open
objStream.Type = 2
objStream.Position = 0
objStream.CharSet = "utf-16"
objStream.WriteText ChrW(28) 'Need this to appear as \u001Cw in the output file
objStream.SaveToFile "C:\temp\test.txt", 2
objStream.Close
You need a read-write stream so that writing to it and saving it to file both work.
Const adModeReadWrite = 3
Const adTypeText = 2
Const adSaveCreateOverWrite = 2
Sub SaveToFile(text, filename)
With CreateObject("ADODB.Stream")
.Mode = adModeReadWrite
.Type = adTypeText
.Charset = "UTF-16"
.Open
.WriteText text
.SaveToFile filename, adSaveCreateOverWrite
.Close
End With
End Sub
text = Chr(28) & "Hello" & Chr(28)
SaveToFile text, "C:\temp\test.txt"
Other notes:
I like to explicitly define with Const all the constants in the code. Makes reading so much easier.
A With block save quite some typing here.
Setting the stream type to adTypeText is not really necessary, that's the default anyway. But explicit is better than implicit, I guess.
Setting the Position to 0 on a new stream is superfluous.
It's unnecessary to use ChrW() for ASCII-range characters. The stream's Charset decides the byte width when you save the stream to file. In RAM, everything is Unicode anyway (yes, even in VBScript).
There are two UTF-16 encodings supported by ADODB.Stream: little-endian UTF-16LE (which is the default and synonymous with UTF-16) and big-endian UTF-16BE, with the byte order reversed.
You can achieve the same result with the FileSystemObject and its CreateTextFile() method:
Set FSO = CreateObject("Scripting.FileSystemObject")
Sub SaveToFile(text, filename)
' CreateTextFile(filename [, Overwrite [, Unicode]])
With FSO.CreateTextFile(filename, True, True)
.Write text
.Close
End With
End Sub
text = Chr(28) & "Hello" & Chr(28)
SaveToFile text, "C:\temp\test.txt"
This is a little bit simpler, but it only offers a Boolean Unicode parameter, which switches between UTF-16 and ANSI (not ASCII, as the documentation incorrectly claims!). The solution with ADODB.Stream gives you fine-grained encoding choices, for example UTF-8, which is impossible with the FileSystemObject.
For the record, there are two ways to create an UTF-8-encoded text file:
The way Microsoft likes to do it, with a 3-byte long Byte Order Mark (BOM) at the start of the file. Most, if not all Microsoft tools do that when they offer "UTF-8" as an option, ADODB.Stream is no exception.
The way everyone else does it - without a BOM. This is correct for most uses.
To create an UTF-8 file with BOM, the first code sample above can be used. To create an UTF-8 file without BOM, we can use two stream objects:
Const adModeReadWrite = 3
Const adTypeBinary = 1
Const adTypeText = 2
Const adSaveCreateOverWrite = 2
Sub SaveToFile(text, filename)
Dim iStr: Set iStr = CreateObject("ADODB.Stream")
Dim oStr: Set oStr = CreateObject("ADODB.Stream")
' one stream for converting the text to UTF-8 bytes
iStr.Mode = adModeReadWrite
iStr.Type = adTypeText
iStr.Charset = "UTF-8"
iStr.Open
iStr.WriteText text
' one steam to write bytes to a file
oStr.Mode = adModeReadWrite
oStr.Type = adTypeBinary
oStr.Open
' switch first stream to binary mode and skip UTF-8 BOM
iStr.Position = 0
iStr.Type = adTypeBinary
iStr.Position = 3
' write remaining bytes to file and clean up
oStr.Write iStr.Read
oStr.SaveToFile filename, adSaveCreateOverWrite
oStr.Close
iStr.Close
End Sub

Convert current charset to windows-1252

Hello I have a script in vbs that will send emails to desired destination
the problem is the output text is corrupted
Current output : ils n’ont
Desired output : ils n'ont etc...
After research I found that I need to convert the text to windows 1252 in order to accept french characters
So I implemented the conversion functions :
Const adTypeBinary = 1
Const adTypeText = 2
//accept a string and convert it to Bytes array in the selected Charset
Function StringToBytes(Str,Charset)
Dim Stream : Set Stream = CreateObject("ADODB.Stream")
Stream.Type = adTypeText
Stream.Charset = Charset
Stream.Open
Stream.WriteText Str
Stream.Flush
Stream.Position = 0
// rewind stream and read Bytes
Stream.Type = adTypeBinary
StringToBytes= Stream.Read
Stream.Close
Set Stream = Nothing
End Function
//accept Bytes array and convert it to a string using the selected charset
Function BytesToString(Bytes, Charset)
Dim Stream : Set Stream = CreateObject("ADODB.Stream")
Stream.Charset = Charset
Stream.Type = adTypeBinary
Stream.Open
Stream.Write Bytes
Stream.Flush
Stream.Position = 0
// rewind stream and read text
Stream.Type = adTypeText
BytesToString= Stream.ReadText
Stream.Close
Set Stream = Nothing
End Function
' This will alter charset of a string from 1-byte charset(as windows-1252)
' to another 1-byte charset(as windows-1251)
Function AlterCharset(Str, FromCharset, ToCharset)
Dim Bytes
Bytes = StringToBytes(Str, FromCharset)
AlterCharset = BytesToString(Bytes, ToCharset)
End Function
but how to detect the current encoding charest in order to convert them to windows-1252?
how should I call my function below properly?
objEmail.Subject = eSubject
objEmail.Textbody = AlterCharset(eTextBody , "How to detect the current charset? ", "windows-1252") <--- how to write it properly here?
EDIT :
Doing this line of code did solve my char issues :
objEmail.Textbody = AlterCharset(eTextBody , "windows-1252 ", "UTF-8")
but the script will work on different PC , so I need to dynamically get the current charset in order to convert it to UTF-8

Hashing of text from memory instead from file

I want to hash the passwort 'HelloWorld' to MD5. Following code is an excerpt from Generating the hash value of a file. The problem is that with the presented code, I need to save the password to a file before hashing it. How can I pass it in memory? I am feeling very uncomfortable with vbs, please excuse me. I do not know what kind of type binary is in vbs.
Option Explicit
MsgBox("Md5 Hash for 'HelloWorld': " & GenerateMD5("HelloWorld"))
Public Function GenerateMD5(ByRef hashInput)
'hashInput is the plain text hash algorithm input
Dim oMD5 : Set oMD5 = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
oMD5.Initialize()
Dim baHash : baHash = oMD5.ComputeHash_2(GetBinaryFile("D:/HASHINPUT.txt"))
GenerateMD5 = ByteArrayToHexStr(baHash)
End Function
Private Function ByteArrayToHexStr(ByVal fByteArray)
Dim k
ByteArrayToHexStr = ""
For k = 1 To Lenb(fByteArray)
ByteArrayToHexStr = ByteArrayToHexStr & Right("0" & Hex(Ascb(Midb(fByteArray, k, 1))), 2)
Next
End Function
Private Function GetBinaryFile(filename)
Dim oStream: Set oStream = CreateObject("ADODB.Stream")
oStream.Type = 1 'adTypeBinary
oStream.Open
oStream.LoadFromFile filename
GetBinaryFile = oStream.Read
oStream.Close
Set oStream = Nothing
End Function
I suspect you need input of data type Byte() for ComputeHash_2(). VBScript can't create that data type by itself, but you should be able to use the ADODB.Stream object for converting a string to a byte array without writing it to a file first. Something like this:
pwd = "foobar"
Set stream = CreateObject("ADODB.Stream")
stream.Mode = 3 'read/write
stream.Type = 2 'text
stream.Charset = "ascii"
stream.Open
stream.WriteText pwd
stream.Position = 0 'rewind
stream.Type = 1 'binary
bytearray = stream.Read
stream.Close

convert a zip file to base64 using vbs in UFT

I have a requirement of converting a zip file from my local machine to base64.
Get/Read the path name from the excel sheet row
convert the file in the path (zip file) to base 64 string
Copy the base 64 value to next column in the excel sheet.
Tried a few but did not work.
Current Code:
Dim inByteArray, base64Encoded
inByteArray = readBytes("F:path/file.zip")
base64Encoded = encodeBase64(inByteArray)
Private Function readBytes(file)
Dim inStream
' ADODB stream object used
Set inStream = CreateObject("ADODB.Stream")
' open with no arguments makes the stream an empty container
inStream.Open
inStream.Type = TypeBinary
inStream.LoadFromFile(file)
readBytes = inStream.Read()
End Function
Private Function encodeBase64(bytes)
Dim DM, EL
Set DM = CreateObject("Microsoft.XMLDOM")
' Create temporary node with Base64 data type
Set EL = DM.CreateElement("tmp")
EL.DataType = "bin.base64"
' Set bytes, get encoded String
EL.NodeTypedValue = bytes
encodeBase64 = EL.Text
End Function
Error 1 in the line inStream.type = TypeBinary:
Arguments are of the wrong type, are out of acceptable range, or are in conflict with one another.
Error 2 in the line readBytes = inStream.Read():
Operation is not allowed in this context.
Error 3 in the line EL.NodeTypedValue = bytes:
Type mismatch
Looks like you got the code from here, but didn't include
Const TypeBinary = 1
Adding this will avoid the "Arguments are of the wrong type ..." error.
Perhaps careful copy will solve your other problems too.
Thanks for that :)
Further for excel sheet read and write I used the below code which helped in achieving my target. Thank you
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("F:\path")
Set ws = objWorkbook.Sheets("Sheet1")
Set ws2 = objWorkbook.Sheets("Sheet2")
rowcount = ws.usedrange.rows.count
for j = 1 to rowcount
fieldvalue = ws.cells(j,1)
inByteArray = readBytes(fieldvalue)
base64Encoded = encodeBase64(inByteArray)
ws2.cells(j,1) = base64Encoded
next

Search And Replace within A Binary Stream

I am trying to change a value in a bytestream array. I am looking for the Null value, and I want to change it to a space. When I try to access the array I get an error message "Type Mismatch".
My VBS Code:
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
Const adSaveCreateNotExist=1
'Create Stream object
Dim BinaryStream
Set BinaryStream = CreateObject("ADODB.Stream")
Dim InputFile
InputFile="C:\Users\oferbe\Documents\Tfachut\prepr\Testinput.txt"
'Specify stream type - we want To get binary data.
BinaryStream.Type = adTypeBinary
'Open the stream
BinaryStream.Open
'Load the file data from disk To stream object
BinaryStream.LoadFromFile InputFile
'Open the stream And get binary data from the object
ReadBinaryFile = BinaryStream.Read
BinaryStream.Close
For i = 0 to UBound(ReadBinaryFile)
If ReadBinaryFile(i)=00 Then ReadBinaryFile(i)=20
Next
BinaryStream.Open
'BinaryStream.Write ByteArray
BinaryStream.Write ReadBinaryFile
Dim OutPutFile
OutPutFile="C:\Users\oferbe\Documents\Tfachut\prepr\Ofer"
'Save binary data To disk
BinaryStream.SaveToFile OutPutFile, adSaveCreateOverWrite
The Read operation returns a byte array, which is basically a binary string having some of the properties of a VBScript array, but not all of them. You're better off reading the binary stream as a regular string:
inputFile = "C:\path\to\your\input.bin"
outputFile = "C:\path\to\your\output.bin"
Set stream = CreateObject("ADODB.Stream")
stream.Open
stream.Type = 2
stream.Charset = "Windows-1252"
stream.LoadFromFile inputFile
data = stream.ReadText
stream.Close
data = Replace(data, Chr(0), Chr(32))
stream.Open
stream.Type = 2
stream.Charset = "Windows-1252"
stream.WriteText data
stream.SaveToFile outputFile, 2
stream.Close
Set stream = Nothing

Resources