msxml3.dll Access Denied - vbscript

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.

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

How to add default signature and new tables in a new outlook mail by testcomplete

I am trying to send new outlook mail by testcomplete using vb scripting language .In that new mail i want to add new tables and keep default signature at bottom of mail by testcomplete. i am getting VB script run time error when i am using this code..please check the code and suggest me the correct methods i have to use to add new tables and signature
Function SendMail()
Dim objOutLook, NamespaceMAPI,objNewMail, fso, SendReceiveControls
Dim strTo,strCc ,strBcc ,strSubject, AccountName,strAttachmentPath
strSubject="test"
strTo=yyy#yy.com
strCc=XXX#XX.com
strBcc =zzz#zzz.com
strAttachmentPath="c:\text.txt"
Set objOutLook = CreateObject("Outlook.Application")
Set NamespaceMAPI = objOutLook.GetNamespace("MAPI")
Set objNewMail = objOutLook.CreateItem(olMailItem)
objOutLook.DisplayAlerts =True
objNewMail.TO = strTo
objNewMail.CC = strCc
objNewMail.BCC=strBcc
objNewMail.Subject = strSubject
objNewMail.Body = strMsg
If strAttachmentPath <> "" Then
Set fso =CreateObject("Scripting.FileSystemObject")
If fso.FileExists(strAttachmentPath) Then
objNewMail.Attachments.Add(strAttachmentPath)
objNewMail.GetDefaultsignature() 'script run time error occured here
objNewMail.addtable(4,3)
objNewMail.display
Else
msgbox "Attachment File Does not exists"
End If
End If
objOutLook.Quit
''''''' Releasing objects '''''''
Set objOutLook =Nothing
Set objNewMail = Nothing
Set fso = Nothing
End Function
please help me.. thanks in advannce....
See if this or this helps. They are alternative methods to yours.
I prefer to use the 2nd option, the CDO method, you just need to take atention to the fact that usually this email goes to the spam inbox, you need to manually add it to your secure contacts

VBScript and loadXML: Invalid at the top level of the document. How to fix it?

This is my fort post on stackoverflow. I have searched many similiar Q&A's on this site but my conditions seem a bit different. here is my vbscript code:
------------ code snippet ---------------
xmlurl = "songs.xml"
set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.async = False
xmlDoc.loadXML(xmlurl)
if xmlDoc.parseError.errorcode<>0 then
'error handling code
msgbox("error! " & xmlDoc.parseError.reason)
end if
------------ end code snippet ---------------
XML:
<?xml version="1.0" encoding="UTF-8"?>
<nowplaying-info-list>
<nowplaying-info mountName="CKOIFMAAC" timestamp="1339771946" type="track">
<property name="track_artist_name"><![CDATA[CKOI]]></property>
<property name="cue_title"><![CDATA[HITMIX]]></property>
</nowplaying-info>
<nowplaying-info mountName="CKOIFMAAC" timestamp="1339771364" type="track">
<property name="track_artist_name"><![CDATA[AMYLIE]]></property>
<property name="cue_title"><![CDATA[LES FILLES]]></property>
</nowplaying-info>
<nowplaying-info mountName="CKOIFMAAC" timestamp="1339771149" type="track">
<property name="track_artist_name"><![CDATA[MIA MARTINA]]></property>
<property name="cue_title"><![CDATA[TOI ET MOI]]></property>
</nowplaying-info>
</nowplaying-info-list>
I also tried removing the first line in case maybe UTF-8 was not compatible with windows (saw some posts about this), but I still got the same error. I also tried unix2dos and vice versa in case there were carriage return issues (hidden characters embedded in the xml). I just can't seem to figure out what's wrong. It's such a simole XML file. I could parse it in a few minutes using perl regex but I need to run this script on windows so using vbscript. I use the same technique to parse XML from other sources without any issues. I cannot modify the XML unfortunately, it is from an external source.
I have this exact same error on both my Windows Vista home edition and Windows Server 2008. I am running the vbscript from the command line for testing so far (ie not in ASP).
Thanks in advance,
Sam
xmlDoc.loadXML() can load an XML string. It cannot retrieve a URL.
Use an XMLHTTPRequest object if you need to make an HTTP request.
Function LoadXml(xmlurl)
Dim xmlhttp
Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
xmlhttp.Open "GET", xmlurl, false
' switch to manual error handling
On Error Resume Next
xmlhttp.Send
If err.number <> 0 Then
WScript.Echo xmlhttp.parseError.Reason
Err.Clear
End If
' switch back to automatic error handling
On Error Goto 0
Set LoadXml = xmlhttp.ResponseXml
End Function
Use like
Set doc = LoadXml("http://your.url/here")
Three addition remarks:
(1) As .parseError.reason tends to be cryptic, it pays to include its .srcTxt
property (and the parameter to .loadXml):
Dim xmlurl : xmlurl = "song.xml"
Dim xmlDoc : Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.async = False
xmlDoc.loadXML xmlurl
If 0 <> xmlDoc.parseError.errorcode Then
WScript.Echo xmlDoc.parseError.reason, "Src:", xmlDoc.parseError.srcText
Else
WScript.Echo "surprise, surprise"
End if
output:
Invalid at the top level of the document.
Src: song.xml
Of course, writing a Function/Sub that takes all properties of .parseError
into account and using that always, would be even better.
(2) To load a file or URL, use .load:
Dim xmlDoc : Set xmlDoc = CreateObject("Microsoft.XMLDOM")
Dim xmlurl
For Each xmlurl In Array("song.xml", "http://gent/~eh/song.xml", "zilch")
xmlDoc.async = False
if xmlDoc.load(xmlurl) Then
With xmlDoc.documentElement.firstChild
WScript.Echo xmlurl _
, .tagName _
, .firstChild.tagName _
, .firstChild.text
End With
Else
WScript.Echo xmlurl, xmlDoc.parseError.reason, "Src:", xmlDoc.parseError.srcText
End if
Next
output:
song.xml nowplaying-info property CKOI-ÄÖÜ
http://gent/~eh/song.xml nowplaying-info property CKOI-ÄÖÜ
zilch The system cannot locate the object specified.
Src:
(3) Using the DOM avoids all encoding problems (that's why I put some
german umlauts into 'your' file - which even made it to the DOS-Box output)
and makes RegExps (even Perl's) a second best choice.

Resources