I have a function which uses MSXML to post an XML document which yesterday started failing despite no change being made to the code. The function is as follows:
Public Function PostFile(ByVal address As String, ByVal data As Byte()) As xmldocument
Dim xmlHTTP As New MSXML2.XMLHTTP
Dim response As New XmlDocument
Dim xmlDoc As New MSXML2.DOMDocument
Try
xmlDoc.load(data)
xmlHTTP.open("post", address, False)
xmlHTTP.send(xmlDoc)
If xmlHTTP.responseXML.xml <> String.Empty Then
response.LoadXml(xmlHTTP.responseXML.xml)
Return response
Else
Dim result As String = "<NO_Response><Error>the post succeeded to " + address + " but there was no responce returned</Error><Hint>Check FireWall Settings</Hint></NO_Response>"
response.loadxml(result)
Return response
End If
Catch ex As Exception
'Error logging code removed
End Try
Return Nothing
End Function
The XML document and the address being passed in are both correct - the line which causes the error is xmlHTTP.send(xmlDoc). I have tried this on 2 different machines with the same error each time and have also tried resinstalling MSXML3, with no success.
The exception thrown is:
InnerException: Nothing
Message: "The system cannot locate the resource specified. "
Source: "msxml3.dll"
StackTrace: " at MSXML2.XMLHTTPClass.send(Object varBody) at comms.HTTPHandler.PostFile(String address, Byte[] data) in D:\SCC\Main\Sender\Http.vb:line 42"
It turned out to be a networking issue - I didn't suspect this at first as the error was raised so quickly which didn't suggest an issue with the endpoint. The problem was with a rule which had been added (don't ask why) to the firewall preventing communication with the destination address.
If you are just processing the xml or dtd is offline, you can use:
xmlDoc.resolveExternals = False
Related
I'm trying to pull data from an NHS API using a little bit of classic ASP (all I know I'm afraid) but am struggling to successfully pass the subscription key to the API.
The instructions are as follows:
Pick a page on the NHS website, for example: https://www.nhs.uk/conditions/acne.
Make a note of the path, for example: conditions/acne.
Using a tool such as curl, Postman or your web browser, make a GET request to https://api.nhs.uk/content/acne with a valid subscription key subscription‑key: {subscription-key} in the request header.
You’ll receive a JSON response structured using schema.org and the fields for this are explained in the following documentation....
From https://developer.api.nhs.uk/documentation/content-api
So, I wrote the following...
<%
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.Open "GET", "https://api.nhs.uk/conditions/abdominal-aortic-aneurysm-screening/", False
on error resume next
xml.setRequestHeader "subscription‑key", "MY-API-KEY-HERE"
xml.setRequestHeader "Content-Type", "application/json"
xml.setRequestHeader "Accept", "application/json"
xml.Send
Response.Write "<h1>The HTML text</h1><xmp>"
Response.Write xml.responseText
Set xml = Nothing
%>
This just gives me the following response:
{ "statusCode": 401, "message": "Access denied due to missing subscription key. Make sure to include subscription key when making requests to an API." }
They have example scripts in 5 different languages but not ASP or even ASP.NET
Any ideas what I can try to get this working?
Thanks
EDIT
Trying the method suggested here How can I post data using cURL in asp classic? ...
<%
Dim http: Set http = Server.CreateObject("WinHttp.WinHttpRequest.5.1")
Dim url: url = "https://api.nhs.uk/conditions/abdominal-aortic-aneurysm-screening/"
'Dim data: data = "something=this" - took this out as its a querystring for POST
With http
Call .Open("GET", url, False)
'Call .SetRequestHeader("Content-Type", "application/x-www-form-urlencoded")
Call .SetRequestHeader("subscription‑key", "MY-API-KEY-HERE")
'Call .Send(data) <- the data was the querystring, so not relevant here
Call .Send()
End With
If Left(http.Status, 1) = 2 Then
'Request succeeded with a HTTP 2xx response, do something...
Else
'Output error
Call Response.Write("Server returned: " & http.Status & " " & http.StatusText)
End If
%>
This gives me Invalid procedure call or argument: 'SetRequestHeader'
EDIT WITH SOLUTION
Working code with hyphen issue fixed...
<%
Dim http: Set http = Server.CreateObject("WinHttp.WinHttpRequest.5.1")
Dim url: url = "https://api.nhs.uk/conditions/abdominal-aortic-aneurysm-screening/"
With http
Call .Open("GET", url, False)
Call .SetRequestHeader("subscription-key", "MYKEYHERE")
Call .Send()
End With
If Left(http.Status, 1) = 2 Then
'Request succeeded with a HTTP 2xx response, do something...
Response.Write http.responseText
Else
'Output error
Call Response.Write("Server returned: " & http.Status & " " & http.StatusText)
End If
%>
Thanks Lankymart!
Tried your take on the duplicate example and it returned
Invalid procedure call or argument: 'SetRequestHeader'
This puzzled me as that code had been tested before and work fine so what changed?
So I dug into the SetRequestHeader method calls.
Turns out the error only occurs on this line;
Call .SetRequestHeader("subscription‑key", "MY-API-KEY-HERE")
In the end, removed subscription‑ from the header name and it worked without causing a compilation error.
That led me to check the hyphen in the code using Asc("‑") and comparing that with a standard hyphen and sure enough they are different.
<%
Response.Write Asc("‑") & "<br />" 'From the code
Response.Write Asc("-") & "<br />" 'Standard hyphen
%>
Output:
-15454
45
Replaced the character with a standard hyphen the error has gone and the code runs returning;
Server returned: 401 Unauthorized
Since upgrading MQ to "IBM MQ Explorer V9.1", the XMS libraries that always worked in previous versions have started behaving differently.
Essentially, the code still recognises the messages as IBytesMessage type, and successfully writes them to file via a Byte array, but the file itself, which is a split zip file, fails to reconstitute itself.
Here's the lions share of that code:
Dim FactoryFactory As XMSFactoryFactory = XMSFactoryFactory.GetInstance(XMSC.CT_WMQ)
'Create a ConnectionFactory Object
cfConnectionFactory = FactoryFactory.CreateConnectionFactory()
'this variable will contain the full path of any file downloaded from MQ
Dim strMQMessageOutputFileDestinationFilePath As String = ""
'This variable will be used to evaluate whether the MQ Message Output file exists
Dim fiMQMessageOutputFile As FileInfo = Nothing
'Set various Connection Factory properties
cfConnectionFactory.SetStringProperty(XMSC.WMQ_HOST_NAME, Me.HostName)
cfConnectionFactory.SetIntProperty(XMSC.WMQ_PORT, 1414)
cfConnectionFactory.SetStringProperty(XMSC.WMQ_CHANNEL, "SYSTEM.DEF.SVRCONN")
cfConnectionFactory.SetIntProperty(XMSC.WMQ_CONNECTION_MODE, 1)
cfConnectionFactory.SetStringProperty(XMSC.WMQ_QUEUE_MANAGER, Me.QueueManager)
cfConnectionFactory.SetIntProperty(XMSC.WMQ_BROKER_VERSION, 0)
'Create a new Iconnection object via the Connection Factory
connection = cfConnectionFactory.CreateConnection()
'Create a sesion via the Connection Object, using ClientAcknowledge mode
'ClientAcknowledge is being used because it allows us to control precisely
'when a message should be removed from the queue
session = connection.CreateSession(False, AcknowledgeMode.ClientAcknowledge)
'Create a destination using the Session Object
destination = session.CreateQueue(Me.mstrDestinationURI)
destination.SetIntProperty(XMSC.DELIVERY_MODE, 1)
'Create a consumer using the Session & Destination Objects
Consumer = session.CreateConsumer(destination)
connection.Start()
'IMessage is the base class that is returned from the Consumer's Receive method
Dim recvMsg As IMessage = Nothing
' Retrieve message from Queue
recvMsg = Consumer.ReceiveNoWait
strFileNameFromMsg = If(Not recvMsg.PropertyExists("fileName"), "",
recvMsg.GetStringProperty("fileName"))
If TypeOf (recvMsg) Is IBytesMessage Then
'Binary Message
Dim msg As IBytesMessage = CType(recvMsg, IBytesMessage)
Dim buffer(msg.BodyLength) As Byte
msg.ReadBytes(buffer)
Dim content As String = Text.Encoding.UTF8.GetString(buffer)
'The PrepareDestinationFile Function will generate a unique file name for the new file
'and ensure that the file does not already exist on the drive
strMQMessageOutputFileDestinationFilePath = PrepareDestinationFile(strFileNameFromMsg)
'A FileStream object is needed to write a binary array to a file
Dim fsZipFile As FileStream = New FileStream(strMQMessageOutputFileDestinationFilePath, FileMode.Create)
'Write the contents of the Byte Array to the File via the FileStream object
fsZipFile.Write(buffer, 0, buffer.Length)
fsZipFile.Close()
End If
So, the code doesn't throw any kind of exception - the code still recognises the messages as IBytesMessage, but the files won't unzip correctly.
Oddly, If we use rfhutilc.exe, we can manually pull files provided we set the Write options as No Headers and not Include MQMD - but the code above always worked in the previous version of MQ / XMS
Any assistance you can provide would be very much appreciated.
I've inherited a classic asp project and as part of the upgrade process we're moving a lot of the business logic to a REST API (WebApi 2.2)
The authorization endpoint for the api is written, and the asp site can call it, but it's very slow compared with calling directly via Postman.
(I'm a C# coder not a VBScript one so the below code may be offensive)
Asp Code:
' Send a prebuilt HTTP request and handle the response
' Returns true if the request returns a 200 response, False otherwise
' Response body is placed in Response
' ErrorMessage is set to return status text if an error code is returned
Function HandleRequest(ByRef objRequest, strBody)
set profiler = Server.CreateObject("Softwing.Profiler")
HandleRequest = False
' Add auth token if we have it
If Not m_accessToken&"" = "" Then
objRequest.SetRequestHeader "Authorization", "Bearer " & m_accessToken
End If
' Originating IP for proxy forwarding
If Not m_clientIp&"" = "" Then
objRequest.SetRequestHeader "X-Forwarded-For", m_clientIp
End If
On Error Resume Next
If (strBody&"" = "") Then
objRequest.Send()
Else
profiler.ProfileStart()
objRequest.Send(strBody)
flSendRequest = profiler.ProfileStop()
End If
If Err.Number = 0 Then
Dim jsonResponse
If (objRequest.ResponseText&"" <> "") Then
profiler.ProfileStart()
set jsonResponse = JSON.parse(objRequest.ResponseText)
flJson = profiler.ProfileStop()
set m_Response = jsonResponse
End If
If objRequest.Status = 200 Then
HandleRequest = True
m_errorMessage = ""
Else
m_errorMessage = objRequest.statusText
End If
Else
m_errorMessage = "Unable to connect to Api server"
End If
On Error GoTo 0
End Function
You can see there's some profiling code in there.
The following post request takes 392ms
POST localhost:5000/oauth/token
Content-Type application/x-www-form-urlencoded
client_id:ABCDEF0-ABCD-ABCD-ABCD-ABCDEF-ABCDEF01234
client_secret:aBcDeF0123456789aBcDeF0123456789=
username:demo
password:demo
grant_type:password
If I issue the same request direct to the Api via Postman it takes 30ms.
That's more than 13x slower.
What gives?
Edit
Raw result from Softwing Profiler:
flJson 10.9583865754112
flSendRequest 392.282022557137
So after a lengthy-ish discussion with the #J-Tolley it looks as though the issue is with the Softwing.Profiler documentation which states;
all results are given in milliseconds
even though earlier in the page it states;
has a ten milliseconds resolution
Have not used the Softwing.Profiler component alone before and would recommend anyone using in a Classic ASP environment to implement it using the SlTiming class library provided by 4GuysFromRolla.
In that article it even warns anyone using the Softwing.Profiler ProfileStop() method to;
Be aware that Softwing.Profiler's ProfileStop method returns a value in ticks (tenths of milliseconds).
I'm trying to query my Server 2012 Essentials R2 server to determine the most recent Client Backup time for a given Device, so I can display nag screens at signon for forgetful users. (They're on laptops, so I can't depend on the machine being available during the automatic window.)
The closest thing in the way of documentation I've been able to find is this: (https://msdn.microsoft.com/en-us/library/jj713757.aspx)
GET services/builtin/DeviceManagement.svc/devices/index/{index}/count/{count}
But it requires a preceding call to get the token: (https://msdn.microsoft.com/en-us/library/jj713753.aspx)
GET https://www.contoso.com/services/builtin/session.svc/login HTTP/1.1
Accept: application/xml
Host: servername
Authorization: Basic VXNlcjpQYXNzd29yZCE=
AppName: Sample App Name
AppPublisher: publisher
AppVersion: 1.0
Does anyone know what the values for those last three headers should be—or how to discover them—for a standard WSE 2012 R2 installation? The documentation provides no assistance here.
Or if someone knows a better way to accomplish this, please let me know.
OK, I got it working. The code is below.
As it turns out, the value of the AppName header is irrelevant—it can be any string, but it can't be empty.
I already knew it couldn't be empty from a look at the WSE source in Wssg.WebApi.Framework in the GAC, but the code is decoupled to the point that it's next to impossible to find out what process picks up the the RemoteConnectionClientInfo object once it gets dropped into the HTTP session.
The part that was misleading me was—go figure—the documentation itself.
There's a bang (!) after the password on the Authentication page, suggesting that it should trail the actual password prior to encoding. This was why I was getting an authentication error, which in turn I was (mistakenly) attributing to the statement in the documentation: "Add Appname, Apppublisher, and Appversion values in HTTP header fields. These values are also required to log on."
So once I cleared all that up, I sailed right in.
And there are other errors in the documentation. On the Devices page we are told that the Host header should be set to the domain name, and that a Content-Length header should be added.
These are both incorrect. The Host header should be the server's hostname and there should be no Content-Length header (that's a response header, not a request header).
AND...! After all this, I find that the Device info returned doesn't contain the most recent backup time. I'll have to dig further for that. But at least now I can connect.
So Microsoft's incomplete, inaccurate and sloppy documentation has cost me a day's work. Hopefully somebody else can use this and avoid the pain I went through.
Module Main
Public Sub Main()
Dim aCredentials() As Byte
Dim _
oAuthenticateUri,
oDeviceListUri As Uri
Dim _
sCanary,
sCookie,
sDevices As String
aCredentials = Encoding.ASCII.GetBytes($"{USERNAME}:{PASSWORD}")
Using oClient As New HttpClient
oAuthenticateUri = New Uri($"https://{HOST}/services/builtin/session.svc/login")
oDeviceListUri = New Uri($"https://{HOST}/services/builtin/devicemanagement.svc/devices/index/0/count/99")
oClient.DefaultRequestHeaders.Accept.Add(New MediaTypeWithQualityHeaderValue("application/xml"))
oClient.DefaultRequestHeaders.Authorization = New AuthenticationHeaderValue("Basic", Convert.ToBase64String(aCredentials))
oClient.DefaultRequestHeaders.Host = HOST
oClient.DefaultRequestHeaders.Add("AppPublisher", String.Empty)
oClient.DefaultRequestHeaders.Add("AppVersion", String.Empty)
oClient.DefaultRequestHeaders.Add("AppName", "None")
Using oAuthenticateResponse As HttpResponseMessage = oClient.GetAsync(oAuthenticateUri).Result
If oAuthenticateResponse.IsSuccessStatusCode Then
sCanary = oAuthenticateResponse.Headers.Single(Function(Pair) Pair.Key = CANARY_HEADER).Value(0)
sCookie = Split(oAuthenticateResponse.Headers.Single(Function(Pair) Pair.Key = COOKIE_HEADER).Value(0), ";")(0)
oClient.DefaultRequestHeaders.Clear()
oClient.DefaultRequestHeaders.Host = HOST
oClient.DefaultRequestHeaders.Add(CANARY_HEADER, sCanary)
oClient.DefaultRequestHeaders.Add(COOKIE_HEADER, sCookie)
Using oDeviceListResponse As HttpResponseMessage = oClient.GetAsync(oDeviceListUri).Result
If oDeviceListResponse.IsSuccessStatusCode Then
sDevices = oDeviceListResponse.Content.ReadAsStringAsync.Result
Else
Console.WriteLine("{0} ({1})", oDeviceListResponse.StatusCode, oDeviceListResponse.ReasonPhrase)
End If
End Using
Else
Console.WriteLine("{0} ({1})", oAuthenticateResponse.StatusCode, oAuthenticateResponse.ReasonPhrase)
End If
End Using
End Using
End Sub
Private Const CANARY_HEADER As String = "Canary"
Private Const COOKIE_HEADER As String = "Set-Cookie"
Private Const USERNAME As String = "domain.admin"
Private Const PASSWORD As String = "admin.password"
Private Const HOST As String = "server"
End Module
I have a vbscript that creates a registry entry on a Windows Server 2003 machine. This script has been working fine for about a year now, but recently it just stopped working. I am thinking that a windows update must have changed something, maybe a security setting, whereby this script is no longer permitted to execute. The script uses the following function to create an entry in HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBC.INI\ for new ODBC connections:
Function CreateRegKey (sComputer, hTree, sKey)
Dim oRegistry
Dim lResult
Set oRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}//" & sComputer & "/root/default:StdRegProv")
lResult = oRegistry.CreateKey(hTree, sKey)
If (lResult = 0) And (Err.Number = 0) Then
CreateRegKey = 0
Else
CreateRegKey = 1
msgbox("Create Key " & sKey & " Failed")
End If
Set oRegistry = Nothing
End Function
This function is called as follows:
Const HKEY_LOCAL_MACHINE = &H80000002
sPath = "SOFTWARE\ODBC\ODBC.INI\" & DataSourceName
'Create ODBC entry
If (0 = CreateRegKey(sComputer, HKEY_LOCAL_MACHINE, sPath)) Then
....
Else
....
End If
Does anyone know of a windows update that could have caused this script to suddenly stop working? The script stops on the following line:
lResult = oRegistry.CreateKey(hTree, sKey)
It does not give an error or anything. It just stops on that line.
Anyone got an idea what is going wrong here and how I could fix it? Thanks.
EDIT: I now get the error number returned by CreateKey. It returns the following:
Err.Number: -2147023533
Err.Description: Cannot start a new logon session with an ID that is already in use
Does anyone know what is causing this and how to work around it? Thanks.
The description for the error code -2147023533 (0x80070553) is:
Cannot start a new logon session with an ID that is already in use.
A search for this code and description reveals:
hotfix KB2283089 for fixing the error,
an assumption that the error is caused by KB979683,
a suggestion to reinstall service packs in order to fix the error.
Give these a try and see if it helps.