Saving remote CSV file locally in asp classic - vbscript

Getting an error when saving a CSV file (datafeed) from a remote server. It works as expected with some datafeeds but flags an error with others.
The code retrieves the remote datafeed and saves it locally as datafeed.csv
Here is the script so far.
Set xhr = Server.CreateObject("MSXML2.ServerXMLHTTP")
xhr.Open "GET", remote_datafeed, False
xhr.Send
IF NOT xhr.Status = 200 THEN
Response.write"Error retrieving remote CSV file"
else
sResponse = split(xhr.responseText, vbcrlf)
set datafeed = fs.CreateTextFile("files/datafeed.csv", true)
For i = 0 to uBound(sResponse)
datafeed.WriteLine sResponse(i)
Next
Response.write "Remote file has successfully been save locally <br>"
datafeed.close
set datafeed = nothing
I somtimes get an error on the following line.
datafeed.WriteLine sResponse(i)
The error im getting is:
Microsoft VBScript runtime error '800a0005'
Invalid procedure call or argument

After looking throught the remote datafeed, turns out it was to do with utf-8 charset. Changed to the following code solved this issue with utf-8 charset.
Dim objStream
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Type = 2
objStream.Mode = 3
objStream.Open
objStream.Position = 0
objStream.Charset = "UTF-8"
objStream.WriteText xhr.responseText
objStream.SaveToFile "files/datafeed.csv"
objStream.Close
Set objStream = nothing

Related

Using variables with setRequestHeader, why won't they work?

Edit: Problem is solved. For some reason the Base64Encode function was putting a line break in the output string, something I didn't notice until I response.write the output and looked at the source code of the page instead of the compiled page.
I'm trying to send JSON to a remote server in order to get back a JSON response (Basically I send them data, they perform calculations based on my data and send back different data). However instead of getting data back the server tells me the request failed authentication.
The Authentication involves sending a base64 encoded string, username, and password combined. These values can change so I'm using variables to pass the information on. This does not work, however if I enter the fully encoded value as a string it does work.
Function GetAPdataPost(sSendHTML, sURL)
dim apHTTP
dim sHTTPResponse
dim API_KEY
dim API_PWD
dim auth
API_KEY = "fred"
API_PWD = "barney"
auth = Base64Encode(API_KEY & ":" & API_PWD)
Set apHTTP = Server.CreateObject("MSXML2.ServerXMLHTTP")
apHTTP.Open "POST", sURL, false
apHTTP.setRequestHeader "Content-Type", "application/json; charset=UTF-8"
apHTTP.setRequestHeader "Authorization","Basic ZnJlZDpiYXJuZXk=" '<-- works
apHTTP.setRequestHeader "Authorization", "Basic " & auth '<-- doesn't work
apHTTP.setRequestHeader "Content-Length", len(sSendHTML)
apHTTP.setRequestHeader "Accept", "*/*"
apHTTP.setRequestHeader "Account-Number", "00000004"
apHTTP.setRequestHeader "Cache-Control", "no-cache"
apHTTP.setRequestHeader "Connection", "close"
On Error Resume Next
apHTTP.send sSendHTML
sHTTPResponse = apHTTP.responseText
If Err.Number = 0 Then
GetAPdataPost = sHTTPResponse
Else
GetAPdataPost = "Something went wrong: " & Err.Number
End If
On Error Goto 0
Set apHTTP = Nothing
End Function
Using the first line result in a proper response form the server, a valid JSON string with all the required data. The second line results in a JSON string saying "The request failed authentication".
So aside from typing out the Base64 encoded string how do I get a variable to be recognised as a valid string?
I should just note that I have tried surrounding auth with double quotes ("") and Chr(34) to no avail.
Edit: Base64 Encode function.
Function Base64Encode(sText)
Dim oXML, oNode
Set oXML = CreateObject("Msxml2.DOMDocument.3.0")
Set oNode = oXML.CreateElement("base64")
oNode.dataType = "bin.base64"
oNode.nodeTypedValue =Stream_StringToBinary(sText)
Base64Encode = oNode.text
Set oNode = Nothing
Set oXML = Nothing
End Function
Function Stream_StringToBinary(Text)
Const adTypeText = 2
Const adTypeBinary = 1
'Create Stream object
Dim BinaryStream 'As New Stream
Set BinaryStream = CreateObject("ADODB.Stream")
'Specify stream type - we want To save text/string data.
BinaryStream.Type = adTypeText
'Specify charset For the source text (unicode) data.
BinaryStream.CharSet = "us-ascii"
'Open the stream And write text/string data To the object
BinaryStream.Open
BinaryStream.WriteText Text
'Change stream type To binary
BinaryStream.Position = 0
BinaryStream.Type = adTypeBinary
'Ignore first two bytes - sign of
BinaryStream.Position = 0
'Open the stream And get binary data from the object
Stream_StringToBinary = BinaryStream.Read
Set BinaryStream = Nothing
End Function
The Base64Encode function was putting a line break in the output string, something I didn't notice until I response.write the output and looked at the source code of the page instead of the compiled page.
Always remember to look at the raw data, not just the displayed data (i.e. not like me)

Error with vbscript to download a file bypassing invalid certificate errors

having a similar problem to this post:
Previous older post here
I'm trying to download a file from a webserver that works great on my internal and external network but not when i try to download from a secure https:// server.
I get the following error Error picture here
I Have tried copying info from above problem but i'm not getting it right. can you please assist?
It works great internally and externally if not trying to access https!
Dim strURL, strFile, strFolder, oFSO, dt, oHTTP, oStream
strURL = "https://xx.xx.xx.xx/DataLogs/xxx.csv" 'external secure site
'strURL = "http://192.168.1.10/DataLogs/PLCData.csv" 'internal test
FileName="xxx.csv"
'FileName="PLCData.csv"
strFile = "xxx.csv" ''# The file name
'strFile = "PLCData.csv" ''# The file name
strFolder = "C:\PLC Data" '# The folder where to save the files
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
''# If the download folder doesn't exist, create it
Set oFSO = CreateObject("Scripting.FileSystemObject")
If Not oFSO.FolderExists(strFolder) Then
oFSO.CreateFolder strFolder
End If
Set dt = CreateObject("WbemScripting.SWbemDateTime")
dt.SetVarDate Now
strFile = oFSO.GetBaseName(strFile) & "-" & Split(dt.Value, ".")(0) & "." & oFSO.GetExtensionName(strFile)
''# Download the URL
Set oHTTP = CreateObject("MSXML2.ServerXMLHTTP") 'replace with? Set oHTTP = CreateObject("MSXML2.XMLHTTP") MSXML2.ServerXMLHTTP
oHTTP.open "GET", strURL, False
oHTTP.send
If oHTTP.Status <> 200 Then
''# Failed to download the file
WScript.Echo "Error " & oHTTP.Status & ": " & oHTTP.StatusText
Else
Set oStream = CreateObject("ADODB.Stream")
oStream.Type = adTypeBinary
oStream.Open
''# Write the downloaded byte stream to the target file
oStream.Write oHTTP.ResponseBody
oStream.SaveToFile oFSO.BuildPath(strFolder, strFile), adSaveCreateOverWrite
oStream.Close
End If

Getting 500 - Internal server error while executing a stored procedure using VB Script in classic asp application

I am supporting an old Classic ASP VBscript application. My bad luck is that I can't even debug the code in my servers. After scripting I need to see the output directly on webpage. The below code is Throwing 500 - Internal server error in webpage. Can you please find where this code has gone wrong. Thanks in advance.
I've followed the below links while building the code
http://www.devx.com/tips/Tip/13399
http://stackoverflow.com/questions/36174283/executing-stored-procedure-of-sql-in-vbscript?noredirect=1#comment59989620_36174283
http://forums.asp.net/t/1767387.aspx?how+to+call+a+stored+procedure+with+date+time+parameters+from+a+classic+asp+page
'Set Connection String to Database
sConnect = "PROVIDER=SQLOLEDB;DATA SOURCE=SCRBNGADK00XXXX;DATABASE=SMART2XXX;UID=XXXX;PWD=XXXX;"
' Establish connection.
Set oConObj = CreateObject( "ADODB.Connection" )
Set oCmdObj = CreateObject("ADODB.Command")
Set Rs1 = CreateObject( "ADODB.Recordset" )
oConObj.ConnectionString = sConnect
oConObj.Open
Set oCmdObj.ActiveConnection = oConObj
oCmdObj.commandtype=adCmdStoredProc
oCmdObj.CommandText = "date_diff"
Set objParm = oCmdObj.CreateParameter("#from", adDBTimeStamp, adParamInput,, R1("LEAVE_FROM"))
oCmdObj.Parameters.Append objParm
Set objParm = oCmdObj.CreateParameter("#To", adDBTimeStamp, adParamInput,, R1("LEAVE_TO"))
oCmdObj.Parameters.Append objParm
Set objParm = oCmdObj.CreateParameter("#companycode", adVarChar, adParamInput,200, R2("COMPANY_CODE"))
oCmdObj.Parameters.Append objParm
Set objParm = oCmdObj.CreateParameter("#locationcode", adVarChar, adParamInput,200, R2("LOCATION_CODE"))
oCmdObj.Parameters.Append objParm
Set objParm = oCmdObj.CreateParameter("#hol", adInteger, adParamOutput)
oCmdObj.Parameters.Append objParm
set Rs1 = oCmdObj.Execute
OutPut = oCmdObj.Parameters("#hol")
If Not IsNull(OutPut) Then
wscript.echo "Result :" & OutPut
End If
Set Rs1 = Nothing
Set oConObj = Nothing
Set oCmdObj = Nothing
The correct answer to this is to turn on detailed error messages (and then make sure your browser doesn't eathide said detailed error messages in the name of "friendliness"). But sometimes you really don't have any control over the server, and can't do any of that. Are you completely screwed? Well, not entirely.
What you can do is turn off error handling via On Error Resume Next, and then manually step through your code via Response.Write and Response.End.
On Error Resume Next
'Set Connection String to Database
sConnect = "PROVIDER=SQLOLEDB;DATA SOURCE=SCRBNGADK00XXXX;DATABASE=SMART2XXX;UID=XXXX;PWD=XXXX;"
' Establish connection.
Set oConObj = CreateObject("ADODB.Connection")
If err.Number <> 0 Then
Response.Write "Error creating connection"
Response.End
End If
Set oCmdObj = CreateObject("ADODB.Command")
If err.Number <> 0 Then
Response.Write "Error creating command object"
Response.End
End If
Set Rs1 = CreateObject("ADODB.Recordset")
If err.Number <> 0 Then
Response.Write "Error creating recordset object"
Response.End
End If
'etc., etc., etc.
In reality, you'd probably only put the error checks after the lines you suspect are causing the problem, and instead of adding dozens of If err.number... sections, you can just have one such section that you keep moving down until you find the error.

Download zip file on site that requires authentication using VBScript

I'm trying to download a ZIP file using VBScript that requires authentication. If you go to the site you'll notice it pops up an authentication prompt. The problem I have is after this script runs the ZIP file is too small for what it should be and is corrupt so I can't open it.
My thought is the download isn't working.
Anyone see what I'm doing wrong?
strHDLocation = "C:\Test\file1.zip"
Set xmlHttp = CreateObject("Microsoft.XMLHTTP")
xmlHttp.Open "GET", "http:downloadsite/report-id=123456", False, "myidhere", "mypwhere"
xmlHttp.Send()
Set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
objADOStream.Type = 1 'adTypeBinary
objADOStream.Write xmlHttp.ResponseBody
objADOStream.Position = 0 'Set the stream position to the start
Set objFSO = Createobject("Scripting.FileSystemObject")
If objFSO.Fileexists(strHDLocation) Then objFSO.DeleteFile strHDLocation
Set objFSO = Nothing
objADOStream.SaveToFile strHDLocation
objADOStream.Close
Set objADOStream = Nothing
As a bare minimum when using IXmlHttpRequest you should check the Status property to make sure that assumptions are not made about what is being returned.
If xmlHttp.Status = 200 Then
'Successful Request
Else
'Something went wrong
End If
It's likely the request has failed for one reason or another and the ResponseBody contains the failed response not the expected ZIP file.

Post data with https does not get processed at Server side

I am having a VBScript which gets invoked from a 3rd party application, the script gets the data from the 3rd party application and opens the URL in an IE browser by passing the data in POST format. The script works fine when I use http as the protocol but the moment I use https, the server side code (request.getParameter("param1")) complains that it is not able to find the parameter in the request object. The script is called by passing the URL and the data. e.g. run.vbs https://xyz.com?param1=1234. Following is the vbscript for your kind perusal. Can you please let me know what I am missing when I am using https as the protocol. Any help is highly appreciated. Many thanks.
If WScript.Arguments.Count = 1 Then
uri = WScript.Arguments.Item(0)
'WScript.Echo "Arguments " & uri
Set WshNetwork = WScript.CreateObject("WScript.Network")
'WScript.Echo "Current User Name: " & WshNetwork.UserName
filename="C:\Documents and Settings\"+WshNetwork.UserName+"\Application Data\XYZ\Profiles\default\Settings.xml"
'WScript.Echo "Current User fileName: " & filename
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.Async = "False"
xmlDoc.Load(filename)
strQuery = "Agent"
Set colItem = xmlDoc.getElementsByTagname(strQuery)
For Each objItem in colItem
Agentid = objItem.getAttribute("Login")
'MsgBox "AgentId = " + AgentID
Next
'uri = uri+"^&agentid="+Agentid
uri = uri+"&agentid="+Agentid
pos = InStr(uri,"?")
extracteduri = Mid(uri,1,pos-1)
params = Mid(uri, pos+1)
postdata = Str2Bytes(params,"us-ascii")
header = "Content-Type: application/x-www-form-urlencoded"
Set IE = CreateObject("InternetExplorer.Application")
'IE.Navigate "about:blank"
'IE.AddressBar = True
'IE.ToolBar = True
'IE.StatusBar = True
IE.Visible = True
'WScript.Sleep 2000
Set shl = WScript.CreateObject("WScript.Shell")
shl.SendKeys "% X"
IE.Navigate extracteduri, Nothing, Nothing, postdata, header
Wscript.Quit
Else
Wscript.Echo "Usage: RunURL.vbs <URL to invoke>"
Wscript.Quit
End If
Function Str2Bytes(Text, CharSet)
Const adTypeText = 2
Const adTypeBinary = 1
'Create Stream object
Dim BinaryStream 'As New Stream
Set BinaryStream = CreateObject("ADODB.Stream")
'Specify stream type - we want To save text/string data.
BinaryStream.Type = adTypeText
'Specify charset For the source text (unicode) data.
If Len(CharSet) > 0 Then
BinaryStream.CharSet = CharSet
Else
BinaryStream.CharSet = "us-ascii"
End If
'Open the stream And write text/string data To the object
BinaryStream.Open
BinaryStream.WriteText Text
'Change stream type To binary
BinaryStream.Position = 0
BinaryStream.Type = adTypeBinary
'Ignore first two bytes - sign of
BinaryStream.Position = 0
'Open the stream And get binary data from the object
Str2Bytes = BinaryStream.Read
End Function
I am now using the below function to get the response from the server using https as the protocol and POST as the format but still the server is not able to see the parameter
Set req = CreateObject("MSXML2.ServerXMLHTTP")
'Set the below option to get rid of the "Certificate authority is invalid or
'incorrect, error code - 80072F0D" error
req.setOption 2, 13056
req.open "POST", extracteduri, False
req.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
encodedParams = Escape(params)
WScript.Echo "encodedParams: " & encodedParams
req.send encodedParams
WScript.Echo "req.responseText: " & req.responseText
Below are the encoded parameters
uui%3DU1%3D123456%26agentid%3D123456
The server still complains that the parameter is missing from the request object.
I am using the same script (XMLHTTP request) but I am encrypting the parameters using the Str2Bytes function (declared above)
Set req = CreateObject("MSXML2.ServerXMLHTTP")
req.setOption 2, 13056
req.open "POST", extracteduri, False
req.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
req.send postdata
WScript.Echo "req.responseText: " & req.responseText
I'd recommend using an XMLHTTPRequest instead of the Internet Explorer COM object. See here for an example. Note that you must encode special characters in the post data.
However, if you want to open the URL in IE anyway, you'd probably better stick with your original approach. In that case I'd check the server for more information about why the server side thinks it cannot find the parameter. Does the request even have a parameter named "param1"?

Resources