How to place these code into a Sub function and call it later when I use vbs? - vbscript

The bounty expires in 4 days. Answers to this question are eligible for a +50 reputation bounty.
HelloCW is looking for an answer from a reputable source.
I'm a beginner of vbs, the Code A is written using vbs, it works well.
I find there are many repeated code in Code A, how to optimize the vbs code ?
Code A
Call Send_HTTP_RequestA()
Call Send_HTTP_RequestB()
Sub Send_HTTP_RequestA()
'Force the script to finish on an error.
On Error Resume Next
'Declare variables
Dim objRequest
Dim URL
Set objRequest = CreateObject("Microsoft.XMLHTTP")
'Put together the URL link appending the Variables.
URL = "http://www.a.com/Task.aspx"
'Open the HTTP request and pass the URL to the objRequest object
objRequest.open "POST", URL , false
'Send the HTML Request
objRequest.Send
'Set the object to nothing
Set objRequest = Nothing
End Sub
Sub Send_HTTP_RequestB()
'Force the script to finish on an error.
On Error Resume Next
'Declare variables
Dim objRequest
Dim URL
Set objRequest = CreateObject("Microsoft.XMLHTTP")
'Put together the URL link appending the Variables.
URL = "http://www.b.com/task.aspx?From=VPSScedule&ForceRun=True"
'Open the HTTP request and pass the URL to the objRequest object
objRequest.open "POST", URL , false
'Send the HTML Request
objRequest.Send
'Set the object to nothing
Set objRequest = Nothing
End Sub
Added Content
Thank you all! Is Code B correct?
Code B
Send_HTTP_Request "http://www.1.com/Task.aspx"
Send_HTTP_Request "http://www.2.com/task.aspx?From=VPSScedule&ForceRun=True"
Sub Send_HTTP_Request(URL)
On Error Resume Next
Dim objRequest
Set objRequest = CreateObject("Microsoft.XMLHTTP")
objRequest.open "POST", URL , false
objRequest.Send
Set objRequest = Nothing
End Sub

Related

How to pass API URI as a variable in vbs script?

I have Vb script for run Put request. I have URL. that URL is saved in the excel and I'm saving that url as variable and pass that url to put command.
Example vURL: https://example.com/api/
I have already tried different arguments and quotations mark but it doesn't work.
Dim args, vURL
Set args = WScript.Arguments
'vURL = WScript.Arguments.Item(0)
'MSXML2.ServerXMLHTTP
'WinHttp.WinHttpRequest.5.1
'MSXML2.ServerXMLHTTP60
vURL = args(0)
MsgBox vURL
Dim http: Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
Dim url: url = vURL
With http
Call .Open("PUT", url, False)
Call .SetRequestHeader("Accept", "application/json")
Call .SetRequestHeader("XAPI-KEY", "")
Call .Send("")
End With
If Left(http.Status, 1) = 2 Then
response = http.responseText
MsgBox response
Else
response = http.responseText
MsgBox response
End If
If I put the vURL without Quotes. Response comes as empty but it should have some kind of response.
If I put the vURL in the quotations, response comes back as is not authorize protocal.
Code works fine when I hard code the URL in.
Thanks #omegastripes for help. I was able to resolve the issue by comparing the length of hard coded URL and vURL. Length wasn't matching.

setting Preemptive authentication for rest api using vbscript

I am using below code to test Rest API using UFT(VBScript).
url ="http://*********"
username = "test"
Pwd = "pwd"
inputfilepath = "C:\TApps\Message.txt"
Set fso = createobject("Scripting.FileSystemObject")
Set fl = fso.OpenTextFile(inputfilepath)
strMsg = fl.readall
Set f1 = Nothing
fl.Close
Set fso = Nothing
Set restReq = CreateObject("Microsoft.XMLHTTP")
restReq.Open "POST", url, False,username,Pwd
restReq.setRequestHeader "Content-Type","application/json"
'restReq.SetRequestHeader "Authentication", "preemptive"
''restReq.setRequestHeader "PreemptiveAuthentiction",true
restReq.setRequestHeader "Accept","application/json"
restReq.Send strMsg
msgbox restReq.responsetext
I am getting error message as in responseText as
[{"error-code":"1","error_msg":"error when reading the key:null}]
There is no issue with json string as manually I am getting the proper response. After doing some analysis, I came to know 'Preemptive Authentication' should be true for my request. Tried by setting using 'SetRequestHeader', but no luck.

Why Doesn't This URL Work in IXMLHttpRequest Object?

I built some code to retrieve stock data from Yahoo as a CSV file, and it works fine. When I change the URL to the perfectly legal version that recalls minutewise data from Google instead, it fails on the
objHTTP.open "GET", strURL, False
statement.
The following code shows both URLs, although obviously only the final one is called. Both URLs work when posted into the address bar of a browser.
Can anyone explain why the call to Google's page won't Open?
option explicit
Dim objHTTP
dim strURL
dim objFile
dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objHTTP = CreateObject("MSXML2.XMLHTTP")
' WORKS:
strURL = "http://real-chart.finance.yahoo.com/table.csv?s=UPRO&a=04&b=21&c=2016&d=04&e=31&f=2016&g=d&ignore=.csv"
' DOES NOT WORK:
strURL = "www.google.com/finance/getprices?q=UPRO&i=60&p=20d&f=d,c,v,k,o,h,l&df=cpct&auto=0&ei=Ef6XUYDfCqSTiAKEMg"
objHTTP.open "GET", strURL, False
objHTTP.send
msgbox objHTTP.responseText
Set objFile = objFSO.CreateTextFile _
("Yahoo.csv", 2)
objFile.Write objHTTP.ResponseText
objFile.Close
You are missing http:// from the broken URL. When I added this, I got response data.

Character encoding Microsoft.XmlHttp in Vbscript

I'm writing a vbscript to pull some data from a webpage, strip out a few key pieces of information and write those to a file.
At the moment my script to access the pages and save the file contents to a string is this:
Set WshShell = WScript.CreateObject("WScript.Shell")
Set http = CreateObject("Microsoft.XmlHttp")
'Load Webpage where address is URL
http.open "GET", URL, FALSE
http.send ""
'Assign webpage contents as a string to variable called Webpage
WEBPAGE = http.responseText
I need to save the content to a string so I can use a regular expression on it to pull out the content that I need.
This script works perfectly, EXCEPT for when the pages contain non-standard characters (such as é). When the page contains something like this, the script throws up an error and stops.
I'm guessing this is something to do with the encoding, but I can't work out how to fix it. Can anyone point me in the right direction? Thanks guys
Edit
Thanks to the help here I realised I've asked the wrong question! It turns out I was downloading the content fine - the problem was, afterwards I was trying to edit it and write it out to a file, and the file was in the wrong format. I had this:
Set objTextFile = objFSO.OpenTextFile(OutputFile, 8, True,)
Changing it to this:
Set objTextFile = objFSO.OpenTextFile(OutputFile, 8, True, -1)
Seems to have fixed it. What a crazy world, eh? Thanks for the help.
You may need to set the correct header blocks before send
eg the following is an example only. You will need to find out what this is exactly for your website
http.open "GET", URL, FALSE
http.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
http.SetRequestHeader "Accept", "text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5"
http.SetRequestHeader "Accept-Language", "en-us,en;q=0.5"
http.SetRequestHeader "Accept-Charset", "ISO-8859-1,utf-8;q=0.7,*;q=0.7"
http.send ""
EDIT:
What about this instead. It works ok here
Dim XMLHttpReq,URL,WEBPAGE
Const Eacute = "%C3%89"
Set XMLHttpReq = CreateObject("MSXML2.ServerXMLHTTP")
URL = "http://en.wikipedia.org/wiki/%C3%89"
'Load Webpage where address is URL
XMLHttpReq.Open "GET", URL, False
XMLHttpReq.send ""
'Assign webpage contents as a string to variable called Webpage
WEBPAGE = XMLHttpReq.responseText
WEBPAGE = Replace(WEBPAGE, Eacute, "É")
'Debug.Print WEBPAGE
The E acute in this case returns as string %C3%89 and you can force it to whatever character you choose if required.
EDIT2:
Just to add, if you're doing this with VBScript you may find this method useful
Dim XMLHttpReq, URL, WEBPAGE, fso, f
Const Eacute = "%C3%89"
Set XMLHttpReq = CreateObject("MSXML2.ServerXMLHTTP")
URL = "http://en.wikipedia.org/wiki/%C3%89"
XMLHttpReq.Open "GET", URL, False
XMLHttpReq.send ""
WEBPAGE = XMLHttpReq.responseText
Save2File WEBPAGE, "C:\Users\osknows\Desktop\test.txt"
Sub Save2File (sText, sFile)
Dim oStream
Set oStream = CreateObject("ADODB.Stream")
With oStream
.Open
.CharSet = "utf-8"
.WriteText sText
.SaveToFile sFile, 2
End With
Set oStream = Nothing
End Sub

vbscript xml problem

I have this vbscript that calls a web service written in .net 2010.
I'm getting an error at the last line. Can't figure it out.
This is the webservice:
http://www.kollelbaaleibatim.com/services/getinfo.asmx/GetFronpageInfo
Dim xmlDOC
Dim bOK
Dim J
Dim HTTP
Dim ImagePathLeftCar, ImagePathRightCar
Dim CarIDLeft, CarIDRight
Dim ShortTitleLeftCar, ShortTitleRightCar
Dim DescriptionLeftCar, DescriptionRightCar
Dim PriceLeftCar, PriceRightCar
Set HTTP = CreateObject("MSXML2.XMLHTTP")
Set xmlDOC =CreateObject("MSXML.DOMDocument")
xmlDOC.Async=False
HTTP.Open "GET","http://www.kollelbaaleibatim.com/services/getinfo.asmx/GetFronpageInfo", false
HTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
HTTP.Send()
dim xmldoc2
set xmldoc2 = Server.CreateObject("Microsoft.XMLDOM")
xmldoc2.async = False
bOK = xmldoc2.load(HTTP.responseXML)
if Not bOK then
response.write( "Error loading XML from HTTP")
end if
response.write( xmldoc2.documentElement.xml)'Prints a good looking xml
ShortTitleLeftCar = xmldoc2.documentElement.selectSingleNode("LeftCarShortTitle").text 'ERROR HERE
This isn't a VBScript issue, it is an xpath issue. xmldoc2.documentElement.selectSingleNode("LeftCarShortTitle") will try find the "LeftCarShortTitle" element as a child of the root....which in your case won't work as there are various levels before this i.e. <string><Root><FrontpageData>.
Update your xpath to be:
//LeftCarShortTitle
This will traverse the descendants of the document and should find the node your looking for.

Resources