Return a binary file to a VBScript caller
It is occasionally necessary to do some heavy computing such as image manipulation while inside a VBScript. Since script isn't suited to this purpose, the way I've accomplished this in the past is to build a c# COM complaint .dll file and reference it from the script. Then the COM file can do the real processing. The downside here is the fact that the .dll needs to be copied to and registered on every machine that might run this script. In one instance that was not practical.
Here is an alternate solution where the VBScript calls a .NET webservice which responds with a binary file. The VBScript then decodes that and saves it to disk. All of this is accomplished using native Windows objects Microsoft.XMLHTTP, Microsoft.XMLDOM and Scripting.FileSystemObject. This particular example service takes a string from the VBScript caller, creates a TIFF image with that string printed in the middle of it and returnes the completed TIFF to the VBScript.
You'll notice that the base64 encoding is automatically generated by the webservice. The return type is actually byte[], but the results from this call will be in xml 1.0. The VBScript is expecting this and selects the response node and decodes the base64 encoding. The base64 decoding functionality was lifted from this board http://www.visualbasicscript.com/m35754.aspx posted by member DiGiTAL.SkReAM. Thanks.
The VBScript code:
Dim xmlhttp: Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
xmlhttp.Open "POST","http://serviceserver/service1.asmx",false
xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
xmlhttp.send "str=THISISMYPOSTINGDATA"
If xmlhttp.Status <> 200 Then
MsgBox "Server response error " & xmlhttp.status & ". " & xmlhttp.statusText & ") " & vbcrlf & "Response: " & xmlhttp.responseText
End If
Dim objFileSystem: Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Dim objFile: Set objFile = objFileSystem.CreateTextFile("c:\testoutput.tiff", True)
Dim response: response = xmlhttp.responseText
Dim xmlDoc: Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.loadxml(xmlhttp.responseText)
Dim responseNode: Set responseNode = xmlDoc.selectSingleNode("//base64Binary")
objFile.write fDecode(responseNode.text)
Set objFile = Nothing
Set objFileSystem = Nothing
Set xmlhttp = Nothing
'The fDecode base64 decoding functionality was lifted from this board http://www.visualbasicscript.com/m35754.aspx posted by member DiGiTAL.SkReAM. It is a concise and fairly speedy base64 decoder
Function fDecode(sStringToDecode)
'This function will decode a Base64 encoded string and returns the decoded string.
'This becomes usefull when attempting to hide passwords from prying eyes.
Const CharList = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim iDataLength, sOutputString, iGroupInitialCharacter
sStringToDecode = Replace(Replace(Replace(sStringToDecode, vbCrLf, ""), vbTab, ""), " ", "")
iDataLength = Len(sStringToDecode)
If iDataLength Mod 4 <> 0 Then
fDecode = "Bad string passed to fDecode() function."
Exit Function
End If
For iGroupInitialCharacter = 1 To iDataLength Step 4
Dim iDataByteCount, iCharacterCounter, sCharacter, iData, iGroup, sPreliminaryOutString
iDataByteCount = 3
iGroup = 0
For iCharacterCounter = 0 To 3
sCharacter = Mid(sStringToDecode, iGroupInitialCharacter + iCharacterCounter, 1)
If sCharacter = "=" Then
iDataByteCount = iDataByteCount - 1
iData = 0
Else
iData = InStr(1, CharList, sCharacter, 0) - 1
If iData = -1 Then
fDecode = "Bad string passed to fDecode() function."
Exit Function
End If
End If
iGroup = 64 * iGroup + iData
Next
iGroup = Hex(iGroup)
iGroup = String(6 - Len(iGroup), "0") & iGroup
sPreliminaryOutString = Chr(CByte("&H" & Mid(iGroup, 1, 2))) & Chr(CByte("&H" & Mid(iGroup, 3, 2))) & Chr(CByte("&H" & Mid(iGroup, 5, 2)))
sOutputString = sOutputString & Left(sPreliminaryOutString, iDataByteCount)
Next
fDecode = sOutputString
End Function
The c# webservice code:
public class Service1 : System.Web.Services.WebService {
[WebMethod]
public byte[] makeBitmap(string str) {
string fontName = "Garamond";
using (Bitmap bmp = new Bitmap(1500, 2000)) {
using (Graphics gfx = Graphics.FromImage((Image)bmp)) {
gfx.SmoothingMode = SmoothingMode.AntiAlias;
Font font = new Font(fontName, 18, FontStyle.Regular, GraphicsUnit.Pixel);
gfx.FillRectangle(Brushes.White, new Rectangle(0, 0, bmp.Width, bmp.Height));
char[] separator = new char[1];
separator[0] = '~';
string[] strs = str.Split(separator);
int counter = 1;
foreach (string s in strs) {
SizeF sz = gfx.MeasureString(s, font);
Rectangle rcText = new Rectangle(0, 0, (int)sz.Width + 5, (int)sz.Height + 5);
rcText.Offset((bmp.Width - rcText.Width) / 2, ((bmp.Height - rcText.Height) / 3) + (int)(sz.Height * counter));
StringFormat strFormat = new StringFormat();
gfx.DrawString(s, font, new SolidBrush(Color.Black), rcText, strFormat);
counter++;
}
MemoryStream ms = new MemoryStream();
ImageCodecInfo myImageCodecInfo;
Encoder myEncoder;
EncoderParameter myEncoderParameter;
EncoderParameters myEncoderParameters;
myImageCodecInfo = GetEncoderInfo("image/tiff");
myEncoder = Encoder.Compression;
myEncoderParameters = new EncoderParameters(1);
myEncoderParameter = new EncoderParameter(myEncoder,(long)EncoderValue.CompressionLZW);
myEncoderParameters.Param[0] = myEncoderParameter;
bmp.Save(ms, myImageCodecInfo, myEncoderParameters);
// Save to memory using the Jpeg format
// read to end
byte[] bmpBytes = ms.GetBuffer();
bmp.Dispose();
ms.Close();
//string returnString = System.Text.ASCIIEncoding.ASCII.GetString(bmpBytes);
return bmpBytes;
}
}
}
private static ImageCodecInfo GetEncoderInfo(String mimeType) {
int j;
ImageCodecInfo[] encoders;
encoders = ImageCodecInfo.GetImageEncoders();
for (j = 0; j < encoders.Length; ++j) {
if (encoders[j].MimeType == mimeType)
return encoders[j];
}
return null;
}
}
