What if TinyURL API doesn't work..? - asp-classic

I have a vbscript function to create a tinyurl from a regular url.
FUNCTION GetShortURL(strUrl)
Dim oXml,strTinyUrl,strReturnVal
strTinyUrl = "http://tinyurl.com/api-create.php?url=" & strUrl
set oXml = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
oXml.Open "GET", strTinyUrl, false
oXml.Send
strReturnVal = oXml.responseText
Set oXml = nothing
GetShortURL = strReturnVal
END FUNCTION
I have come across the problem when the tinyurl api is down or inaccessible, making my script fail:
msxml3.dll
error '80072efe'
The connection with the server was terminated abnormally
Is there a safeguard I can add to this function to prevent the error and use the long url it has..?
Many thanks in advance,
neojakey

If you want to just return strUrl if the call fails, you can use On Error Resume Next
FUNCTION GetShortURL(strUrl)
on error resume next
Dim oXml,strTinyUrl,strReturnVal
strTinyUrl = "http://tinyurl.com/api-create.php?url=" & strUrl
set oXml = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
oXml.Open "GET", strTinyUrl, false
oXml.Send
strReturnVal = oXml.responseText
Set oXml = nothing
'Check if an error occurred.
if err.number = 0 then
GetShortURL = strReturnVal
else
GetShortURL = strUrl
end if
END FUNCTION

Obviously, you need some kind of error handling. In general, VBScript's error handling is no fun, but for your specs - get the right thing or the default in case of any/don't care what problem - you can use a nice and simple approach:
Reduce your original function to
assignment of default value to function name (to prepare for the failures)
On Error Resume Next (to disable VBScript's default error handling, i.e. crash)
assignment of the return value of a helper function to function name (to prepare for success)
In code:
Function GetShortURL2(strUrl)
GetShortURL2 = strUrl
On Error Resume Next
GetShortURL2 = [_getshorturl](GetShortURL2)
End Function
I use [] to be able to use an 'illegal' function name, because I want to emphasize that _getshorturl() should not be called directly. Any error in _getshorturl() will cause a skip of the assignment and a resume on/at the next line (leaving the function, returning the default, reset to default error handling).
The helper function contains the 'critical parts' of your original function:
Function [_getshorturl](strUrl)
Dim oXml : Set oXml = CreateObject("Msxml2.ServerXMLHTTP.3.0")
oXml.Open "GET", "http://tinyurl.com/api-create.php?url=" & strUrl, False
oXml.Send
[_getshorturl] = oXml.responseText
End Function
No matter which operation fails, the program flow will resume on/at the "End Function" line of GetShortURL2().
Added: Comments on the usual way to do it (cf. Daniel Cook's proposal)
If you switch off error handling (and "On Error Resume Next" is just that) you are on thin ice: all errors are hidden, not just the ones you recon with; your script will do actions in all the Next lines whether necessary preconditions are given or preparations done.
So you should either restrict the scope to one risky line:
Dim aErr
...
On Error Resume Next
SomeRiskyAction
aErr = Array(Err.Number, Err.Description, Err.Source)
On Error Goto 0
If aErr(0) Then
deal with error
Else
normal flow
End If
or check after each line in the OERN scope
On Error Resume Next
SomeRiskyAction1
If Err.Number Then
deal with error
Else
SomeRiskyAction2
If Err.Number Then
deal with error
Else
...
End If
End If
That's what I meant, when I said "no fun". Putting the risky code in a function will avoid this hassle.

Related

Is possible to add a String.contains more than one value?

I want to make a control, when I create a companyId, to not permit to create id with special characters like, (&), (/), (), (ñ), ('):
If txtIdCompany.Text.Contains("&") Then
// alert error message
End If
But I can't do this:
If txtIdCompany.Text.Contains("&", "/", "\") Then
// alert error message
End If
How can I check more than one string in the same line?
You can use collections like a Char() and Enumerable.Contains. Since String implements IEnumerable(Of Char) even this concise and efficient LINQ query works:
Dim disallowed = "&/\"
If disallowed.Intersect(txtIdCompany.Text).Any() Then
' alert error message
End If
here's a similar approach using Enumerable.Contains:
If txtIdCompany.Text.Any(AddressOf disallowed.Contains) Then
' alert error message
End If
a third option using String.IndexOfAny:
If txtIdCompany.Text.IndexOfAny(disallowed.ToCharArray()) >= 0 Then
' alert error message
End If
If txtIdCompany.Text.Contains("&") Or txtIdCompany.Text.Contains("\") Or txtIdCompany.Text.Contains("/") Then
// alert error message
End If

Time management of a script asp

within a page ASP (classic) I have a function that connects to the server via XMLHTTP to google to get the time and distance between two points.
I noticed that sometimes my server makes this request very slowly sending the script out and blocking the page.
I would therefore ask you.
If I change the attached script to say
if the execution time exceeds five seconds then stops the script
function GooDistInd(origine,destintario)
Set objxml = Nothing
' Dichiaro le variabili che mi servono nello script
Dim file, objXmlHttp, objXmlDom, distanza, cognome, i
'http://maps.google.com/maps/api/directions/xml?origin=40.7143528,-74.0059731&destination=40.7035458,-74.21607971&sensor=false
file = "http://maps.googleapis.com/maps/api/directions/xml?origin="& origine &"destination="&destintario &"&sensor=false"
Set objXmlHttp = Server.CreateObject("Microsoft.XMLHTTP")
objXmlHttp.Open "GET", file, False
objXmlHttp.Send
Set objXmlDom = Server.CreateObject("Microsoft.XMLDOM")
objXmlDom.async = False
objXmlDom.loadXML(objXmlHttp.responseText)
Set tempo = objXmlDom.getElementsByTagName("leg/distance/value")
i = 0
For i = 0 To tempo.length - 1
distanza=tempo(i).Text
exit for
Next
GooDistInd =distanza
end function
If you want to stop the script completely you could use
Server.ScriptTimeout = 5
You could also use the timeut property of the Microsoft.XMLHTTP object and set it to 5000 ms. In this case you could work with on error resume next and check if an error occurred, so you could give back a significant error message to you users

Not getting attribute from a xml file into asp

I have the following xml result from this link - https://api.eveonline.com/eve/CharacterID.xml.aspx?names=BorisKarlov
<eveapi version="2">
<currentTime>2013-01-16 18:57:38</currentTime>
<result>
<rowset name="characters" key="characterID" columns="name,characterID">
<row name="BorisKarlov" characterID="315363291"/>
</rowset>
</result>
<cachedUntil>2013-02-16 18:57:38</cachedUntil>
</eveapi>
and I am trying to extract the characterID into asp. I am using the following code,
Set oXML = Server.CreateObject("Msxml2.DOMDocument.6.0")
oXML.LoadXML("https://api.eveonline.com/eve/CharacterID.xml.aspx?names=BorisKarlov")
Set oRoot = oXML.selectSingleNode("//result")
For Each oNode In oRoot.childNodes
response.Write oNode.Attributes.getNamedItem("characterID").Text
Next
Set oXML = Nothing
All i keep getting is the following error:
Microsoft VBScript runtime error '800a01a8'
Object required: 'oRoot'
.............
I can only assume that Set oRoot = oXML.selectSingleNode("//result") is not actually generating any data and therefore throwing up the error in the next line.
Can anyone please shed some light on my problem?
You have a few problems there.
loadXML() is for loading a block of XML as a string, not fetching from a remote server; for that, you need to use load()
when loading from a server, you need to tell it to use the ServerXMLHTTP component, and set async to false so that it waits until loaded before executing the rest of your script.
when I tried loading that XML, I got an encoding error; you will need to resolve that one way or another
when I loaded the XML directly from a string, it wouldn't parse because there is a script element containing non-XML content; that needs to be contained within a CDATA section
your XPath query is to //result, but you actually need it to be //result/rowset
This code should work once you resolve issues 3 and 4 above:
Set oXML = Server.CreateObject("Msxml2.DOMDocument.6.0")
oXML.async = False
oXML.setProperty "ServerHTTPRequest", true
oXML.Load("https://api.eveonline.com/eve/CharacterID.xml.aspx?names=BorisKarlov")
If oXML.parseError.errorCode <> 0 Then
Response.Write "<p>XML parse error: " & Server.HTMLEncode(oXML.parseError.reason) & "</p>"
Else
Set oRoot = oXML.selectSingleNode("//result/rowset")
If oRoot Is Nothing Then
response.write "Nothing!"
response.end
End If
For Each oNode In oRoot.childNodes
response.Write oNode.Attributes.getNamedItem("characterID").Text
Next
End If
Set oXML = Nothing
Edit: to get around the problem #3, and oddly also #4 (don't know why!), use this snippet to load the XML instead. For some reason, I think the code above isn't handling the gzip compressed stream correctly, but this code below does.
Set oXML = Server.CreateObject("Msxml2.DOMDocument.6.0")
Set xh = Server.CreateObject("Msxml2.ServerXMLHTTP.6.0")
xh.open "GET", "https://api.eveonline.com/eve/CharacterID.xml.aspx?names=BorisKarlov", False
xh.send
xml = xh.responseText
oXML.LoadXML xml

Issuing a POST request with a large amount of data fails in VB6

I have a pretty standard function to post some XML string data to a remote WCF service and extract the result. It works fine, but fails to scale to a "large" amount of data (138KB in this case.)
' performs a HTTP POST and returns the resulting message content
Function HttpPost(sUrl As String, sSOAPAction As String, sContent As String) As String
Dim oHttp As Object
'Set oHttp = CreateObject("Microsoft.XMLHTTP")
Set oHttp = CreateObject("MSXML2.XMLHTTP.6.0")
oHttp.open "POST", sUrl, False
oHttp.setRequestHeader "SOAPAction", """http://conducive.com.au/IXpacManagement/" & sSOAPAction & """"
oHttp.setRequestHeader "Content-Type", "text/xml; charset=utf-8"
oHttp.setRequestHeader "Content-Length", Len(sContent)
oHttp.send Str(sContent)
If oHttp.status = 200 Then
HttpPost = oHttp.responseText
Else
MsgBox "An error (" & LTrim(Str(oHttp.status)) & ") has occurred connecting to the server."
HttpPost = ""
End If
Set oHttp = Nothing
End Function
When I use Microsoft.XMLHTTP I get error 7 out of memory.
When I use MSXML2.XMLHTTP.6.0 I get object doesn't support this property or method.
In either case sending a small string of under a thousand characters works perfectly.
Here's what I get when I try different ways of sending the string:
Using oHttp.send(sContent): Even small POSTs fail with Invalid procedure call or argument Runtime error 5.
Using oHttp.send sContent: Even small POSTs fail with Invalid procedure call or argument Runtime error 5.
In the end oHttp.send CStr(sContent) worked. Thank you all for the suggestions because I was lost.
Try taking out the Str() around sContent and just using parentheses to pass it by value, e.g.
oHttp.send (sContent)
or failing that at least use CStr() - Str() is supposed to convert numbers to strings.

asp ERROR MESSAGE

How I can solve this error message
Microsoft VBScript runtime error
'800a01a8' Object required: 'lUATRef'
/cmgtest/transaction/viewPCReqForm.asp,
line 284
this is some source code that I wrote below
function checkUATReq(aUATRef)
Dim correctness,lUATRef,uatRef
correctness = False
lUATRef = aUATRef
uatRef = lUATRef.Substring(1,2)
rwriteln uatRef
'sqlCheckUATReq = "select * from PC_DETAIL where ID ='"&uatReqRef&"'"
'rwriteln uatReqRef
End function
Seems like your function isn't getting a parameter passed to it. Check whether aUATRef is getting initialized.
In VBScript, Strings aren't objects. You should use the Mid function to get a portion of a string:
uatRef = Mid(IUATRef, 1, 2)

Resources