What I'm trying to do is encode a gif file, to include in an XML document.
This is what I have now, but it doesn't seem to work.
Function gifToBase64(strGifFilename)
On Error Resume Next
Dim strBase64
Set inputStream = WScript.CreateObject("ADODB.Stream")
inputStream.LoadFromFile strGifFilename
strBase64 = inputStream.Text
Set inputStream = Nothing
gifToBase64 = strBase64
End Function
I recently wrote a post about this very subject for implementations in JScript and VBScript. Here is the solution I have for VBScript:
Public Function convertImageToBase64(filePath)
Dim inputStream
Set inputStream = CreateObject("ADODB.Stream")
inputStream.Open
inputStream.Type = 1 ' adTypeBinary
inputStream.LoadFromFile filePath
Dim bytes: bytes = inputStream.Read
Dim dom: Set dom = CreateObject("Microsoft.XMLDOM")
Dim elem: Set elem = dom.createElement("tmp")
elem.dataType = "bin.base64"
elem.nodeTypedValue = bytes
convertImageToBase64 = "data:image/png;base64," & Replace(elem.text, vbLf, "")
End Function
In your comment to Tomalak you state you don't want to use external dlls but in your attempted example you try to use ADODB. I suspect therefore what you mean is you don't want to install dlls that aren't natively present on a vanilia windows platform.
If that is so then MSXML may be your answer:-
Function Base64Encode(rabyt)
Dim dom: Set dom = CreateObject("MSXML2.DOMDocument.3.0")
Dim elem: Set elem = dom.appendChild(dom.createElement("root"))
elem.dataType = "bin.base64"
elem.nodeTypedValue = rabyt
Base64Encode = elem.Text
End Function
Take a look here: Base64 Encode & Decode Files with VBScript. This example relies on the free XBase64 component and merely provides a wrapper for file handling.
You can also go for a pure VBScript implementation, but here you have to care for the file handling yourself. Should not be too difficult, but encoding performance will be not as good. For a few small image files it will be enough, though.
Google will turn up more.
Related
In my MSI Windows Installer I have a custom VBScript action which extracts some files from the 'Binary' table to the filesystem. This is the code I'm using:
Inspired by: https://www.itninja.com/question/how-to-call-an-exe-which-is-stored-in-a-binary-table-through-a-vbscript-custom-action-in-the-msi
Function ExtractFromBinary(ByVal binaryName, ByVal binaryOutputFile)
Dim oFSO : Set oFSO = CreateObject("Scripting.FileSystemObject")
Const msiReadStreamInteger = 0
Const msiReadStreamBytes = 1
Const msiReadStreamAnsi = 2
Const msiReadStreamDirect = 3
Dim binaryView : Set binaryView = Session.Database.OpenView("SELECT Data FROM Binary WHERE Name = '" & binaryName & "'")
binaryView.Execute
Dim binaryRecord : Set binaryRecord = binaryView.Fetch
Dim binaryData : binaryData = binaryRecord.ReadStream(1, binaryRecord.DataSize(1), msiReadStreamAnsi)
Set binaryRecord = Nothing
Dim binaryStream : Set binaryStream = oFSO.CreateTextFile(binaryOutputFile, True, False)
binaryStream.Write binaryData
binaryStream.Close
Set binaryStream = Nothing
End Function
This has been used without any issues in production for 2-3 years now. However now we have a case on a Japanese Windows installation where the extracted binary files are corrupted:
As you can see, the problem typically after a '?' where the script either inserts an 'E', or overwrites the following character.
Both the ReadStream method and the CreateTextFile method have a parameter which affect encoding. The combination shown above seems to be the only one which works on my English Windows 10.
What do I need to change in the code above to make it work also on a Japanese system?
#Robert-Hegner I'll propose this as an answer, even though it is subject to your testing (I have no way of testing where I am)!
I've included an updated approach here (you will need to scroll down to the second example)
It uses msiReadStreamDirect (not msiReadStreamAnsi) to extract a string of Byte pairs, converts these into binary and creates the output file using the ADODB.Stream (not the FSO).
Dim oFSO : Set oFSO = CreateObject("Scripting.FileSystemObject")
Dim tempFolder : tempFolder = oFSO.GetSpecialFolder(2)
Dim outputFile : outputFile = tempFolder & "\notepad.exe"
extractFromBinary "notepad", outputFile
Function MultiByteToBinary(MultiByte)
'obtained from http://www.motobit.com
'MultiByteToBinary converts multibyte string To real binary data (VT_UI1 | VT_ARRAY)
'Using recordset
Dim RS, LMultiByte, Binary
Const adLongVarBinary = 205
Set RS = CreateObject("ADODB.Recordset")
LMultiByte = LenB(MultiByte)
If LMultiByte>0 Then
RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte
RS.Open
RS.AddNew
RS("mBinary").AppendChunk MultiByte & ChrB(0)
RS.Update
Binary = RS("mBinary").GetChunk(LMultiByte)
End If
Set RS = Nothing
MultiByteToBinary = Binary
End Function
Function SaveBinaryData(FileName, ByteArray)
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
'Create Stream object
Dim BinaryStream
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 ByteArray
'Save binary data To disk
BinaryStream.SaveToFile FileName, adSaveCreateOverWrite
Set BinaryStream = Nothing
End Function
Function extractFromBinary(ByVal binaryName, ByVal binaryOutputFile)
Const msiReadStreamInteger = 0
Const msiReadStreamBytes = 1
Const msiReadStreamAnsi = 2
Const msiReadStreamDirect = 3
Dim binaryView : Set binaryView = Session.Database.OpenView("SELECT * FROM Binary WHERE Name = '" & binaryName & "'")
binaryView.Execute
Dim binaryRecord : Set binaryRecord = binaryView.Fetch
Dim binaryData : binaryData = binaryRecord.ReadStream(2, binaryRecord.DataSize(2), msiReadStreamDirect)
Set binaryRecord = Nothing
'convert to string of byte pairs to binary
binaryData = MultiByteToBinary(binaryData)
'save binary data
SaveBinaryData binaryOutputFile, binaryData
End Function
Set oFSO = Nothing
Japanese Code Page: From this blog entry: "Binary Files and the File System Object Do Not Mix": "In the Japanese code page, just-plain-chr(E0) is not even a legal character, so Chr will turn it into a zero... Do not use the FSO to read/write binary files, you're just asking for a world of hurt as soon as someone in DBCS-land runs your code."
Alternatives? How about .NET? I realized too late that you are in a custom action, I made the samples as standalone .NET console applications. The WiX framework has mechanisms to create a DTF custom action. Found this on github.com.
Rehashing?: Can we ask what you are actually doing? Why do you need to extract files this way? There could be other approaches that
are more reliable if you explain the scenario?
DTF / .NET: Though I am not a huge .NET fan for deployment use (too many layers of dependencies), I think you would do better using .NET / DTF for this. What is DTF?
Sample DTF C# Application: Below is a simple, C# sample application showing one way to extract a binary stream from the Binary table (there are several other ways, I am not a .NET expert).
Create a new C# Console App (.NET Framework).
Paste the below code in and adjust parameters.
Add reference to Microsoft.Deployment.WindowsInstaller.dll (DTF framework).
using Microsoft.Deployment.WindowsInstaller;
namespace MSIExtractBinaryTableEntry
{
class Program
{
static void Main(string[] args)
{
// ADJUST 1: Name of Binary Table Entry
var binarytableentry = "ImageBmp";
// ADJUST 2: Source MSI path
var msifullpath = #"C:\MySetup.msi";
// ADJUST 3: Output target path for binary stream
var binaryfileoutputpath = #"C:\Output.XXX";
using (var db = new Database(msifullpath, DatabaseOpenMode.ReadOnly))
{
using (var binaryView = db.OpenView("SELECT Name, Data FROM Binary WHERE Name='" + binarytableentry + "'"))
{
binaryView.Execute();
binaryView.Fetch().GetStream(2, binaryfileoutputpath); // force overwrites output path
}
}
}
}
}
Alternative: Here is a tweak that exports the whole Binary Table to a folder called "Output" on the user's desktop.
Same procedure to create a test project as above. Only one parameter to specify: the full path to the input MSI.
using System;
using System.IO;
using Microsoft.Deployment.WindowsInstaller;
namespace MSIExtractBinaryTableEntry
{
class Program
{
static void Main(string[] args)
{
// ADJUST 1: Specify MSI file path
var msifullpath = #"C:\MySetup.msi";
var outputpath = Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Desktop), #"Output\");
Directory.CreateDirectory(outputpath);
using (var db = new Database(msifullpath, DatabaseOpenMode.ReadOnly))
{
using (var binaryView = db.OpenView("SELECT Name, Data FROM Binary"))
{
binaryView.Execute();
foreach (var rec in binaryView)
{
rec.GetStream("Data", outputpath + rec.GetString("Name"));
}
}
}
}
}
}
Here is what I ended up with.
As suggested by Stein Åsmul I rewrote the custom action using C# (.NET / DTF). Initially I was hesitant to writing custom actions in C# as it introduces additional prerequisites to the installer. But it turns out that if the custom action targets .NET Framework 2.0, it should be supported on most machines without the need to manually install the framework (see here).
So here is my code:
public static class TemporaryFilesExtractor
{
[CustomAction]
public static ActionResult ExtractTemporaryFiles(Session session)
{
ExtractFromBinary(session, "binaryname1", "<filePath1>");
ExtractFromBinary(session, "binaryname2", "<filePath2>");
return ActionResult.Success;
}
private static void ExtractFromBinary(Session session, string binaryName, string binaryOutputFile)
{
session.Log($"Extracting {binaryName} to {binaryOutputFile}");
byte[] buffer = new byte[4096];
using (var view = session.Database.OpenView("SELECT Data FROM Binary WHERE Name = '{0}'", binaryName))
{
view.Execute();
using (var record = view.Fetch())
using (var dbStream = record.GetStream(1))
using (var fileStream = File.OpenWrite(binaryOutputFile))
{
int count;
while ((count = dbStream.Read(buffer, 0, buffer.Length)) != 0)
fileStream.Write(buffer, 0, count);
}
}
}
}
Made a function to save a word document previously created and modified in another function, but it is sending me an error: This is not a valid file name.
This is my code:
Set obj_Word = CreateObject("Word.Application")
obj_Word.Visible = True
Set doc = obj_Word.Documents.Open("C:\Evidencias3.docx")
NombreDocumento = DataTable.Value("Preguntas","Global")
Sub SaveEvidences()
obj_Word.Visible = True
doc.SaveAs("C:\Evidencias_"& NombreDocumento &".docx")
obj_Word.Quit
Set obj_Word = Nothing
End Sub
I appreciated any help or recommended
You can try to clean out the file name before saving:
Public Function CleanFileName(ByVal sIn As String) As String
Dim sOut As String, sIllegalChars As String
sIllegalChars = "\/:*|?<>" + Chr(34)
sOut = sIn
For q = 1 To Len(sIllegalChars)
sOut = Replace(sOut, Mid(sIllegalChars, q, 1), "_")
Next
CleanFileName = sOut
End Function
Usage:
doc.SaveAs(CleanFileName("C:\Evidencias_"& NombreDocumento &".docx"))
Reference: MSDN - Naming Files, Paths, and Namespaces
Perhaps the problem is in the line:
NombreDocumento = DataTable.Value("Preguntas","Global")
Not familiar with the code, is it possible that it is returning a null value? If so, you could try to append an empty string to it:
NombreDocumento = DataTable.Value("Preguntas","Global") & ""
Either way, I would debug the code and see what the constructed filename actually is. Perhaps then it will become obvious.
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
I'm successfully running the code below to display a text file to the browser, line by line:
<%
Filename = "/pages/test.txt"
Set FSO = server.createObject("Scripting.FileSystemObject")
Filepath = Server.MapPath(Filename)
Set file = FSO.GetFile(Filepath)
Set TextStream = file.OpenAsTextStream(1, -2)
Do While Not TextStream.AtEndOfStream
Line = TextStream.readline
Response.Write Line & "<br>"
Loop
Set TextStream = nothing
Set FSO = nothing
%>
I'd like to run the Do While Not TextStream.AtEndOfStream loop one more time, right before the Set TextStream = nothing statement.
Turns out I cannot "just" copy the Do While loop and place it below the first instance. There are no results from the TextStream anymore.
Is there a way to reset the TextStream object back to the beginning of the stream?
I could store the lines in an array and utilize that, but I wanted to see if there was an easier route.
Unfortunately, there's no way to manually position the pointer in a TextStream object. You can Close the TextStream and reopen it. Or, you can just read the file once into an array, as you implied. Considering you're outputting the entirety of the file to a web page, I'll assume it's not incredibly large and, therefore, storing it in an array would not be too memory intensive.
' Create an array containing each line from the text file...
a = Split(file.OpenAsTextStream(1, -2).ReadAll(), vbCrLf)
For i = 0 To UBound(a)
Response.Write a(i) & "<br>"
Next
' Repeat the process...
For i = 0 To UBound(a)
Response.Write a(i) & "<br>"
Next
You could even replace the line endings with <br> and write it in one operation:
strText = Replace(file.OpenAsTextStream(1, -2).ReadAll(), vbCrLf, "<br>")
Response.Write strText
Response.Write strText ' Write it again
Limitations of the TextStream Object
The TextStream object in the Visual Basic Script Runtime is very limited in what it can do.
Reading is Forward Only which means you cannot go back to an earlier point in the stream.
Writing is all or nothing, when a file is open in ForWriting mode the contents of the file is truncated before being overwritten (as pointed out to avoid this use ForAppending).
Is There Another Way?
Introducing the ADODB.Stream Object!
Fortunately ADODB provides a far more flexible streaming object called ADODB.Stream which among other things allows you to open a file (text or binary) and control the Position property allowing you to read from an earlier point in the stream.
Something like;
<%
Dim TextStream, Filename, Filepath
Filename = "/pages/test.txt"
Filepath = Server.MapPath(Filename)
Set TextStream = Server.CreateObject("ADODB.Stream")
Call TextStream.Open()
TextStream.Type = adTypeText
Call TextStream.LoadFromFile(Filepath)
Do While Not TextStream.EOS
Line = TextStream.ReadText(adReadLine)
Call Response.Write(Line & "<br>")
Loop
'Reset stream back to start of the stream
TextStream.Position = 0
Do While Not TextStream.EOS
Line = TextStream.ReadText(adReadLine)
Call Response.Write(Line & "<br>")
Loop
Call TextStream.Close()
Set TextStream = Nothing
%>
Obviously this is just a quick example (untested) of how to work with the ADODB.Stream. It's worth noting that you can improve this by moving the TextStream.Position = 0 and Do While loop into a separate function that can be re-used and cuts down on the duplication. For the purposes of this answer however have kept it simple.
More Information
MSDN Library - Stream Object (ADO)
Using METADATA to Import DLL Constants (For avoiding issues with Named Constants used in this example)
I need source code for reading the .txt content from a URL.
My text file content sample and then load in Visual Basic 6.0:
My source code:
Dim data As String
data = Inet1.OpenURL("http://test.com/sample.txt")
Text1.Text = data
There is nothing that will only "download" a line at a time as it can't tell where the line breaks are until it's downloaded it.
If you only want to read/process a line at a time, you can split on the line breaks after downloading it:
Dim Data As String
Dim DataLines() As String
Data = Inet1.OpenURL("http://test.com/sample.txt")
DataLines = Split(Data, vbCrLf)
For Index = LBound(DataLines) to UBound(DataLines)
MsgBox DataLines(Index)
Next
You will need to be careful to make sure you have the correct line break for the data being read.
When dealing with HTTP you have to consider both line separators and character encoding. If you can make assumptions after testing then you can bypass some checking and just hard-code to fit your needs.
However the creay old Internet Transfer Control ("Inet") is usually not the best choice available and more modern alternatives are shipped as part of Windows since at least the advent of IE 5.5, and installed with IE 5.5 on more ancient versions of Windows. Thus they'll even be available and work on nearly any Win95 system still running today.
'References to MSXML 3.0 or later,
' ADO 2.5 or later.
Private Function GetHttpText(ByVal URL As String) As ADODB.Stream
Dim Req As MSXML2.XMLHTTP
Dim CharSet As String
Dim CharsetPos As Long
Dim LineSeparator As LineSeparatorEnum
Set Req = New MSXML2.XMLHTTP
Set GetHttpText = New ADODB.Stream
With GetHttpText
.Open
.Type = adTypeBinary
With Req
.Open "GET", URL, False
.send
CharSet = LCase$(.getResponseHeader("CONTENT-TYPE"))
End With
.Write Req.responseBody
CharsetPos = InStr(CharSet, "charset")
If CharsetPos Then
CharSet = Split(Mid$(CharSet, CharsetPos), "=")(1)
Else
'UTF-8 is a reasonable "default" these days:
CharSet = "utf-8"
End If
If CharSet = "utf-8" Then
LineSeparator = adLF
Else
'Your milage may vary here, since there is no line-end
'header defined for HTTP:
LineSeparator = adCRLF
End If
.Position = 0
.Type = adTypeText
.CharSet = CharSet
.LineSeparator = LineSeparator
End With
End Function
Private Sub DumpTextLineByLine()
With GetHttpText("http://textfiles.com/art/simpsons.txt")
'Read text line by line to populate a multiline TextBox
'just as a demonstration:
Do Until .EOS
Text1.SelText = .ReadText(adReadLine)
Text1.SelText = vbNewLine
Loop
.Close
End With
End Sub