Display JPEG using Response.BinaryWrite - vbscript

I'm displaying an image like this:
<img src='counter.asp'>
counter.asp is doing a hit-counter do determine how often the image was displayed (I'll replace it with a modrewrite URL).
The problem: in the counter.asp script I need to send the actual .jpg image to the browser. How could this be done? I suppose I need to load the image through FSO, and then send it using Response.BinaryWrite - any ideas?

To read and output binary you can simply use the ADODB.Stream object.
See the ADODB.Stream MSDN Library:
http://msdn.microsoft.com/en-us/library/ms675032(VS.85).aspx
Here's an example I found from Experts Exchange as well:
Function ReadBinaryFile(strFileName)
on error resume next
Set oStream = Server.CreateObject("ADODB.Stream")
if Err.Number <> 0 then
ReadBinaryFile=Err.Description
Err.Clear
exit function
end if
oStream.Type = 1
oStream.Open
oStream.LoadFromFile strFileName
if Err.Number<>0 then
ReadBinaryFile=Err.Description
Err.Clear
exit function
end if
ReadBinaryFile=oStream.Read
oStream.Close
set oStream = nothing
if Err.Number<>0 then ReadBinaryFile=Err.Description
End Function

you can just redirect your counter.asp to the image you want..
<%
response.redirect("/virtual/path/to/yourimage.jpg")
%>

FSO cannot load a binary file, only text. You will need to use a 3th party component.

Related

Spaces and carriage returns are being added to HTML email

We have a server generated HTML file (myFile.html) that we embed in emails that get sent to our clients. We've been using this method for years with minimal issues. We use Windows Server 2012 with smtp server via II6. Recently the HTML is getting skewed in the email. When checking the source file, all looks well. Directly opening the HTML file for viewing in a browser works as you'd expect. Here is the code we're using to read the file into memory to prepare for emailing:
Set objFile = objFSO.OpenTextFile(strFilePath)
Do While objFile.AtEndOFStream <>True
line = objFile.ReadLine
If Instr(1, line, "<table") > 0 And strHeaderWritten = "N" Then
strHeaderWritten = "Y"
strFileContent=strFileContent & strHeader
End If
strFileContent=strFileContent & line
Loop
set objFile = Nothing
And then we add the content to the email and send:
strBody = strFileContent
Set objMail = CreateObject("CDO.Message")
Set objMail.Configuration = cdoConfig
objMail.From = strFrom
objMail.ReplyTo = strReplyTo
objMail.To = strTo
objMail.Subject = strSubject
objMail.HTMLBody = strBody
objMail.Fields("urn:schemas:httpmail:importance").Value = strImportance
objMail.Send
And here are examples of what it spits out in the email. There are no errors in the source:
Has anyone else had this happen to them?
Been toiling over this for hours looking for an explanation. Thank so much for reading!
I tried using the ADO Stream method for the email, but it is still coming out the same:
Dim objStream
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Type = 2 'adTypeText
objStream.CharSet = Application("CharacterSet")
objStream.Open
objStream.LoadFromFile strFilePath
Do While Not objStream.EOS
line = objStream.ReadText(-2)
If Instr(1, line, "<table") > 0 And strHeaderWritten = "N" Then
strHeaderWritten = "Y"
strFileContent=strFileContent & strHeader
End If
If Instr(1, line, "< table") > 0 Then
strFileContent=strFileContent & "<h3>Broken HTML</h3>"
End If
strFileContent=strFileContent & line
Loop
objStream.Close
Set objStream = Nothing
As you can see, I also added a check for one of the persistent errors I'm seeing where there has been a space inserted between < and table. Checking the output this way did not capture the issue as in checking the text for the added space. So it must be happening after it's been written or I need to use a regex for the test. I'll try that next. I'm still seeing it in multiple email clients. Here's an example post test of ADO Stream:
This seems to be a common problem in CDO. I've found a few references online to the problem that spaces are randomly inserted into the HTMLbody.
One answer was to make the HTML body not one long string, because CDO will then insert random spaces, but to include whitespace yourself, so that CDO doesn't have to.
You could try adding VbCrLf or just plain spaces in the text you're sending.
A second suggestion made more sense to me; this can be an encoding problem. That also explains why adding your own whitespace could be a workaround.
Anyway; CDO allows for setting the encoding of the CDO.Message object before sending.
Try objMail.BodyPart.ContentTransferEncoding = "quoted-printable" to see if that solves it.
The issue is windows use of both line break and carrage return. I recommend loading the body of the text and replacing all instances of vbcrlf with just vblf and you will find you wont have the double spacing anymore.
e.g.
body = replace(body, vbcrlf, vblf)

Errors Loading a Network File into a Stream in Classic ASP

I have a Classic ASP website that currently loads PDF files from a local directory and writes them to the Response. I create a stream and use LoadFromFile to pull the data. This has worked well for years, but we now want to delete the local files and pull from a network "\" drive, where all of our .NET sites pull the files from.
We do this in our .NET sites with no problem, but I cannot figure out how to open a network file from Classic ASP and load it into a stream. Nothing I have tried seems to recognize the "\server\directory\file" as a valid path.
So, just to be as clear as possible, this is what we do:
Pull a DocID from the QueryString.
Pass the DocID as a parameter to a SQL proc to pull the path to the file (In the current ASP page it pulls a local path, in .NET it pulls a network path. In our new ASP page it will now pull a network path).
We create a stream and load the file into it (this is the part that does not work in Classic ASP if the path is "\" instead of "D:\").
We change the Response.ContentType to "application/pdf".
We Response.BinaryWrite and Flush the Response.
The result is the page displays the PDF with no indication of the file name or location.
Adding partial code:
' sets the Cache-Control HTTP header to prevent proxy caching
Response.CacheControl = "Private"
Response.Expires = 0
Response.Buffer = True
Response.Clear
sDocID = Request.QueryString("DocID")
sSQL = "exec Get_DocData '" & sDocID & "'"
Set rsDoc = Server.CreateObject("ADODB.RecordSet")
rsDoc.Open sSQL, conn, 3, 1
'
' sPath = \\server\directory\filename.ext
' sFileName = filename.ext
'
sPath = rsDoc.Fields("DocPath").Value
sFileName = rDoc.Fields("DocDescription").Value
rsDoc.Close
Set rsDoc = Nothing
'sPath = Replace(sPath,"\\<svr>\<dir>","Z:")
If sPath <> "" Then
Set oStream = Server.CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1 ' adTypeBinary
oStream.LoadFromFile sPath
Response.ContentType = "application/pdf"
Response.AddHeader "Content-Disposition", "inline; filename=""" & sFileName & """"
Response.Charset = "UTF-8"
Do while not oStream.EOS
Response.BinaryWrite oStream.read(3670016)
Response.Flush
Loop
oStream.Close
Set oStream = Nothing
Else
Response.ContentType = "text/html"
'Response.Write("Invalid Document ID.")
End If
Response.End
Well, I knew I would feel stupid when I figured this out. As Lankymart commented, the LoadFromFile() does support UNC formatted paths, which lead me to suspect the issue was permission-based and not code-based.
Although our ApplicationPool was running under a general account which had permission to the network drives, the site was not. I simply brought up the site in IIS7, clicked on Basic Settings and used the "Connect as..." button to run the site under the same general account. That corrected my issue. Palm-slapping my head.

Download and save a webpage using vbscript

I am trying to give users the option to download and save a webpage to where ever they want. I have been looking all over for a solution but nothing seems to be working. I am using vbscript in classic asp.
This is what I tried last
dim xHttp: Set xHttp = createobject("Microsoft.XMLHTTP")
dim bStrm: Set bStrm = createobject("Adodb.Stream")
xHttp.Open "GET", "" &Session("ServerURL") & "/idautomation/IDAutomationStreamingLinear.aspx?D=MAPS$"&request.QueryString("catcode")&"%25"&request.QueryString("typecode")&"&X=0.09&BH=3&S=0&CC=T&LM=5&TM=7.5&ST=F", False
xHttp.Send
with bStrm
.type = 1 '//binary
.open
.write xHttp.responseBody
.savetofile "d:\DownloladPdf.pdf", 2 '//overwrite
end with
but its throwing a "Write to file failed. " on the .savetofile line.
I want the user to be able to chose where to save it to...
You can't save to the users computer from server side code VBscript directly as this would be a major security issue allowing drive by compromises of people browsing a web page. The reason possibly that it is throwing an error is that it is trying to save it server side, but there is no D: on the server.
Instead you want to serve the PDF to the browser using Response and let the browser display or save the PDF.
The below example is using a bytes array rather than a stream, but it should be similar. If you want to force it to download rather than show in the browser, change the content-disposition to attachment. You can also change the filename to whatever you like.
if Len(pdfBytes) > 0 then
Response.Clear()
Response.ContentType = "application/pdf"
Response.Charset = ""
Response.AddHeader "Cache-Control", "public, max-age=1" ' Setting Cache-Control to max-age=1 rather than no-cache due to IE8 bug
Response.AddHeader "content-disposition","inline; filename=filename.pdf"
Response.Buffer = True
Response.Expires = 0
Response.BinaryWrite(pdfBytes)
Response.Flush
Response.End
Response.Close
end if

Is XMLHTTP's responsebody working asynchronously in VB6?

We have a SSRS integrated sharepoint server. I am trying to get a report exported as PDF from it.
(I had to do like this, because my url is too long. I would rather use Shell command to do like this, although this looks like a better solution.)
Here'is my code:
Dim request as New XMLHTTP
Dim oStream as New Stream
Dim aBunchOfMiliseconds as Long
Dim fileLocation as String
Dim reportUrl as String
aBunchOfMiliseconds = 500
reportUrl = "http://www.mySharepointDomain.com/_vti_bin/ReportServer?http://www.mySharepointDomain.com/sites/AFolderHere/OOAnotherFolder/BlaBlaReportFolder/FolderFolder/AhTheLastOne/AtLeastMyReportFile.rdl&rs:Command=Render&rc:Toolbar=true&rs:Format=PDF&Parameter1=ABC &Parameter2=1&Parameter3=1&TheLastParameter=IllBeDamned&rs%3aParameterLanguage=ln-LN"
request.Open "GET", reportUrl
request.setRequestHeader "WWW-Authenticate", "NTLM" 'For impersonation
request.Send 'Go get it Bruce
If request.Status = 200 Then 'Are you successful?
oStream.Type = adTypeBinary
oStream.Open
oStream.Write request.responseBody 'Here's the problematic part
Sleep(aBunchOfMiliseconds) 'If I don't do this, file will be corrupted
oStream.SaveToFile fileLocation, adSaveCreateOverWrite
oStream.Close
End If
Set oStream = Nothing
Set request = Nothing
If I comment out the "Sleep" line, I will have a corrupted file that can not open. This code works fine but I found it ridiculus to use "Sleep" there.
Is there any way me to understand that the data copy operation is completed?
Oh I get it.
I've missed to say that "this is not an async call".
request.Open "GET", reportUrl, False

msxml3.dll Access Denied

I have the following code:
Function filejson(json)
Dim objStream, strData
Set objStream = CreateObject("ADODB.Stream")
objStream.CharSet = "utf-8"
objStream.Open
objStream.LoadFromFile(json)
strData = objStream.ReadText()
filejson = strData
End Function
Function http2json(url)
Set http = CreateObject("Microsoft.XmlHttp")
http.open "GET", url, FALSE
http.send "" '<------- Line 13
http2json=http.responseText
End Function
Function str2json(json,value)
Set scriptControl = CreateObject("MSScriptControl.ScriptControl")
scriptControl.Language = "JScript"
scriptControl.AddCode("x="& json & ";")
str2json= scriptControl.Eval( "x"& value )
End Function
Function get_json_from_file(json,value)
get_json_from_file=str2json(filejson(json),value)
End Function
Function get_json_from_http(url,value)
get_json_from_http=str2json(http2json(url),value)
End Function
Function save_json_from_http(url,loc)
Set fso = CreateObject("Scripting.FileSystemObject")
fullpath = fso.GetAbsolutePathName(loc)
Dim objStream, strData
Set objStream = CreateObject("ADODB.Stream")
objStream.CharSet = "utf-8"
objStream.Open
objStream.WriteText http2json(url)
objStream.SaveToFile fullpath, 2
save_json_from_http=fullpath
End Function
Wscript.Echo save_json_from_http("http://api.themoviedb.org/3/authentication/session/new?api_key=#####some_api_key_example#####&request_token=#####some_default_request_token######&_ctime_json_=1372670635.164760555","tmdb\temp\_tmdb_sock_w.164519518.2109")
When I run this code, I get the following error.
If I remove &request_token=#####some_default_request_token###### it works just fine.
I also tried this: I added again the request_token, and I just typed a random character in it, for example, rexfuest_token, and strangely it worked. It seems there's a wrong parse in msxml3.dll. with request_token word.
Ideas?
This problem could be related to the security issues in Windows. The best way to fix it is to replace Microsoft.XmlHttp/MSXML2.XMLHTTP with MSXML2.ServerXMLHTTP.
I see the topic is almost 2 years old and most likely the topic starter has solved is issue. I have experienced the same issue couple hours ago and google provided me several links. There are some of them:
https://social.msdn.microsoft.com/Forums/en-US/1abda1ce-e23c-4d0e-bccd-a323aa7f2ea5/access-is-denied-while-using-microsoftxmlhttp-to-get-a-url-link-in-vbscript-help?forum=xmlandnetfx
https://support.webafrica.co.za/index.php?/Knowledgebase/Article/View/615/41/msxml3dll-error-80070005-access-is-denied---loading-xml-file
http://www.experts-exchange.com/Programming/Languages/Scripting/ASP/Q_27305017.html
Try with a more recent version:
Set http = CreateObject("Msxml2.XMLHttp.6.0")
It could also be an issue with your Internet security settings (see here). Open the Internet Options applet in the Control Panel, select the zone for the website (probably "Trusted sites") in the Security tab and click Custom level….
In the section Miscellaneous set Access data sources across domains to Enabled.
Also can change URL from http to https. Me helps
For me the solution was to add the URL in trusted sites.
Internet explorer browser > Tools > Internet options > Security > Trusted sites > Sites > Add the URL under "Add this website to the zone: " and click add and save.

Resources