I trying send information to server this works well but I need convert this POST to JSON.
How can I do it please?
thank you
Dim xPoslatUmo As String = ConfigurationManager.AppSettings.Item("UMOPoslat")
If xPoslatUmo = "Ano" Then
Dim request As WebRequest = WebRequest.Create(ConfigurationManager.AppSettings.Item("UMOServer"))
request.Method = "POST"
Dim postdata As String = "{""GENCELEK"":""SAS_CALLC""},{""GENMSGTEXT"":""info""},{""Volat"":" + xvolat + "},{""Stav"":""" + xstav + "},{""Info"":""" + Left(xinfo, 255) + "}"
Dim byteArray As Byte() = Encoding.UTF8.GetBytes(postdata)
request.ContentType = "application/x-www-form-urlencoded"
request.ContentLength = byteArray.Length
Dim dataStream As Stream = request.GetRequestStream()
dataStream.Write(byteArray, 0, byteArray.Length)
dataStream.Close()
Dim response As WebResponse = request.GetResponse()
mlog.LogujKontroly(postdata)
mlog.LogujKontroly("Poslani UMO " + (CType(response, HttpWebResponse)).StatusDescription)
response.Close()
Else
mlog.LogujKontroly("Poslani UMO - je nastaveno neposilat")
End If
Related
Im working on an old VB.NET (ASP.NET) web page, and I need to get the response for an HttpWebRequest call as follows:
Dim s As HttpWebRequest
Dim enc As UTF8Encoding
Dim postdatabytes As Byte()
s = httpWebRequest.Create("www.theurl.com/api")
enc = New System.Text.UTF8Encoding()
Dim PostData = "grant_type=client_credentials"
postdata = postdata & "&client_id=" & ConfigurationManager.AppSettings("client_id")
postdata = postdata & "&client_secret=" & ConfigurationManager.AppSettings("client_secret")
postdata = postdata & "&audience=" & ConfigurationManager.AppSettings("audience")
postdatabytes = enc.GetBytes(postdata)
s.Method = "POST"
s.ContentType = "application/x-www-form-urlencoded"
s.ContentLength = postdatabytes.Length
Using stream = s.GetRequestStream()
stream.Write(postdatabytes, 0, postdatabytes.Length)
End Using
Dim result = s.GetResponse()
response.write(result)
The problem I have is that, instead of getting the Json string I get with Postman, I get this when response writing "result":
System.Net.HttpWebResponse
Any ideas?
Thanks!
For those looking for an answer, I made it work by adding the following code:
Dim responsedata As Stream = result.GetResponseStream
Dim responsereader As StreamReader = New StreamReader(responsedata)
Dim xResponse = responsereader.ReadToEnd
Response.Write(xResponse)
Thanks.
I have a curl command I was given and trying to convert and use it in .net. I have tried many different scenarios but this was the closest one I thought would work. Anyone know what I am doing wrong? the response back si saying invalid API Key
Curl COMMAND = https://api.com/api/v1/scores --data "token=YOUR_API_TOKEN"
Dim request As HttpWebRequest = HttpWebRequest.Create("https://api.com/api/v1/groups")
request.Proxy = Nothing
request.Method = "GET"
request.ContentType = "application/json"
request.Headers.Add("Authorization", "Basic " + Convert.ToBase64String(New ASCIIEncoding().GetBytes(String.Format("{0}={1}", "Token", personalaccesstoken))))
'create the response and reader
Dim Response As HttpWebResponse = request.GetResponse
Dim ResponseStream As System.IO.Stream = Response.GetResponseStream
'Create Stream reader
Dim StreamReader As New System.IO.StreamReader(ResponseStream)
Dim data As String = StreamReader.ReadToEnd
StreamReader.Close()
'get the data
jsonString = data.ToString.Replace("'", "''")
I ended up resolving this issue with the following code.
Dim request As HttpWebRequest = HttpWebRequest.Create(apiURI)
request.Proxy = Nothing
request.Method = "POST"
request.ContentType = "application/x-www-form-urlencoded"
Dim postData As String = "token=22222222222222222"
Dim encoding As ASCIIEncoding = New ASCIIEncoding()
Dim byte1 As Byte() = encoding.GetBytes(postData)
request.ContentLength = byte1.Length
Dim newStream As Stream = request.GetRequestStream()
newStream.Write(byte1, 0, byte1.Length)
Dim Response As HttpWebResponse = request.GetResponse
Dim ResponseStream As System.IO.Stream = Response.GetResponseStream
'Create Stream reader
Dim StreamReader As New System.IO.StreamReader(ResponseStream)
_jsonString = StreamReader.ReadToEnd
StreamReader.Close()
I'm creating a VB.NET program that I'd like to interface with dropbox. I'm starting with the "list_folder" command which will return the contents on a specified path. Here is the URL where you can play with the command:
https://dropbox.github.io/dropbox-api-v2-explorer/#files_list_folder
The HTTP request syntax provided is as follows:
POST /2/files/list_folder
Host: https://api.dropboxapi.com
User-Agent: api-explorer-client
Authorization: Bearer HBNBvdIls8AA12AAFTvyzhNJrdwwpQcswxpRVjmwRIJANPIea7Jc1Ke
Content-Type: application/json
{
"path": "/Backups"
}
What I'm trying to do is the equivalent in a VB.NET command. Here's what i have so far:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim uri As String = "https://api.dropboxapi.com/2/files/list_folder"
Dim request As Net.HttpWebRequest = Net.HttpWebRequest.Create(uri)
request.Method = "POST"
request.UserAgent = "api-explorer-client"
' this is wrong, need to supply an 'authorization token' somehow:
Dim credentials As New Net.NetworkCredential("username", "password")
request.Credentials = credentials
request.ContentType = "application/json"
'request.ContentLength = ???
' how do I set content to the "path: backups" data?
Dim response As Net.HttpWebResponse = request.GetResponse
Debug.Print(response.StatusDescription)
Dim dataStream As IO.Stream = response.GetResponseStream()
Dim reader As New IO.StreamReader(dataStream) ' Open the stream using a StreamReader for easy access.
Dim responseFromServer As String = reader.ReadToEnd() ' Read the content.
MsgBox(responseFromServer) ' Display the content.
' Cleanup the streams and the response.
reader.Close()
dataStream.Close()
response.Close()
End Sub
What I'm missing is somehow encoding the "path": "/Backups" data specified by the doc into the request object. I'm also missing how to encode the "Authorization" access token into the request. (Above I'm using a username/password but that's probably wrong.)
Can anybody complete the VB.NET HTTP request for me? Thanks very much.
** UPDATE new code based on helpful links from the_lotus -- this works, thanks!:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim uri As String = "https://api.dropboxapi.com/2/files/list_folder"
Dim request As Net.HttpWebRequest = Net.HttpWebRequest.Create(uri)
request.Method = "POST"
request.UserAgent = "api-explorer-client"
request.Headers.Add("Authorization", "Bearer HBN-BvdIlsAAAFTyAQzhNJrBNINPIea7Jc1Ke")
'{
'"path": "/Backups"
'}
Dim json_data As String = "{"+ Chr(34) + "path" + Chr(34) + ": " + Chr(34) + "/Backups" + Chr(34) + "}"
request.ContentType = "application/json"
Dim json_bytes() As Byte = System.Text.Encoding.ASCII.GetBytes(json_data)
request.ContentLength = json_bytes.Length
Dim stream As IO.Stream = request.GetRequestStream
stream.Write(json_bytes, 0, json_bytes.Length)
Dim response As Net.HttpWebResponse = request.GetResponse
Debug.Print(response.StatusDescription)
Dim dataStream As IO.Stream = response.GetResponseStream()
Dim reader As New IO.StreamReader(dataStream) ' Open the stream using a StreamReader for easy access.
Dim responseFromServer As String = reader.ReadToEnd() ' Read the content.
MsgBox(responseFromServer) ' Display the content.
' Cleanup the streams and the response.
reader.Close()
dataStream.Close()
response.Close()
End Sub
You can add custom header with request.Headers.
request.Headers.Add("Authorization", "Bearer HBN-BvdIlsAAAFTyAQzhNJrBNINPIea7Jc1Ke")
To send the POST information, you can use request.GetRequestStream.
Also, make sure the data send in the POST is properly formatted JSON.
Dim url As String = String.Format("{0}folders/{1}", boxApiUrl, ParentFolderId) 'ParentFolderId being pass is "0"
Using request = New HttpRequestMessage() With {.RequestUri = New Uri(url), .Method = HttpMethod.Post}
request.Headers.Authorization = New System.Net.Http.Headers.AuthenticationHeaderValue("Authorization", "Bearer " + acctoken)
Dim data As Dictionary(Of [String], [String]) = New Dictionary(Of String, String)()
data.Add("name", FolderName)
Dim content As HttpContent = New FormUrlEncodedContent(data)
request.Content = content
Dim response = _httpClient.SendAsync(request).Result
If response.IsSuccessStatusCode Then
'
End If
End Using
My suspicion is that data is not being put together properly but can't figure out how else to pass folder name to be created under the root. All other functions (reading root folder, uploading file, etc.) using the token works fine.
The parent folder ID is passed in the POST body, not the URL. The body should be JSON data in the form: { "name": "FolderName", "parent": { "id": "ParentFolderId" }}. Documentation.
Dim url As String = String.Format("{0}folders", boxApiUrl)
Using request = New HttpRequestMessage() With {.RequestUri = New Uri(url), .Method = HttpMethod.Post}
request.Headers.Authorization = New System.Net.Http.Headers.AuthenticationHeaderValue("Authorization", "Bearer " + acctoken)
Dim format as String = #"{{ ""name"":""{0}"", ""parent"": {{ ""id"":""{1}"" }} }}";
Dim body as String = String.Format(format, FolderName, ParentFolderId);
request.Content = New StringContent(body, Encoding.UTF8, "application/json")
Dim response = _httpClient.SendAsync(request).Result
If response.IsSuccessStatusCode Then
'
End If
End Using
As an aside, you can use Json.NET's JsonConvert.SerializeObject method to serialize an anonymous or static type to a JSON string:
Dim obj = New With {Key .name = FolderName,
.parent = New With {Key .id = ParentFolderId }};
Dim body as String = JsonConvert.SerializeObject(body);
request.Content = New StringContent(body, Encoding.UTF8, "application/json")
I need to handle a JSON Object which is the response of XMLHTTPRequest in Excel VBA. I wrote the code below, but it doesn't work:
Dim sc As Object
Set sc = CreateObject("ScriptControl")
sc.Language = "JScript"
Dim strURL As String: strURL = "blah blah"
Dim strRequest
Dim XMLhttp: Set XMLhttp = CreateObject("msxml2.xmlhttp")
Dim response As String
XMLhttp.Open "POST", strURL, False
XMLhttp.setrequestheader "Content-Type", "application/x-www-form-urlencoded"
XMLhttp.send strRequest
response = XMLhttp.responseText
sc.Eval ("JSON.parse('" + response + "')")
I am getting the error Run-time error '429' ActiveX component can't create object in the line Set sc = CreateObject("ScriptControl")
Once we parsed the JSON Object, how do you access the values of the JSON Object?
P.S. My JSON Object sample: {"Success":true,"Message":"Blah blah"}
The code gets the data from nseindia site which comes as a JSON string in responseDiv element.
Required References
3 Class Module i have used
cJSONScript
cStringBuilder
JSON
(I have picked these class modules from here)
You may download the file from this link
Standard Module
Const URl As String = "http://www.nseindia.com/live_market/dynaContent/live_watch/get_quote/GetQuote.jsp?symbol=ICICIBANK"
Sub xmlHttp()
Dim xmlHttp As Object
Set xmlHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
xmlHttp.Open "GET", URl & "&rnd=" & WorksheetFunction.RandBetween(1, 99), False
xmlHttp.setRequestHeader "Content-Type", "text/xml"
xmlHttp.send
Dim html As MSHTML.HTMLDocument
Set html = New MSHTML.HTMLDocument
html.body.innerHTML = xmlHttp.ResponseText
Dim divData As Object
Set divData = html.getElementById("responseDiv")
'?divData.innerHTML
' Here you will get a string which is a JSON data
Dim strDiv As String, startVal As Long, endVal As Long
strDiv = divData.innerHTML
startVal = InStr(1, strDiv, "data", vbTextCompare)
endVal = InStr(startVal, strDiv, "]", vbTextCompare)
strDiv = "{" & Mid(strDiv, startVal - 1, (endVal - startVal) + 2) & "}"
Dim JSON As New JSON
Dim p As Object
Set p = JSON.parse(strDiv)
i = 1
For Each item In p("data")(1)
Cells(i, 1) = item
Cells(i, 2) = p("data")(1)(item)
i = i + 1
Next
End Sub
I've had a lot of success with the following library:
https://github.com/VBA-tools/VBA-JSON
The library uses Scripting.Dictionary for Objects and Collection for Arrays and I haven't had any issues with parsing pretty complex json files.
As for more info on parsing json yourself, check out this question for some background on issues surrounding the JScriptTypeInfo object returned from the sc.Eval call:
Excel VBA: Parsed JSON Object Loop
Finally, for some helpful classes for working with XMLHTTPRequest, a little plug for my project, VBA-Web:
https://github.com/VBA-tools/VBA-Web
I know this is an old question but I've created a simple way to interact with Json from web requests. Where i've wrapped the web request as well.
Available here
You need the following code as a class module called Json
Public Enum ResponseFormat
Text
Json
End Enum
Private pResponseText As String
Private pResponseJson
Private pScriptControl As Object
'Request method returns the responsetext and optionally will fill out json or xml objects
Public Function request(url As String, Optional postParameters As String = "", Optional format As ResponseFormat = ResponseFormat.Json) As String
Dim xml
Dim requestType As String
If postParameters <> "" Then
requestType = "POST"
Else
requestType = "GET"
End If
Set xml = CreateObject("MSXML2.XMLHTTP")
xml.Open requestType, url, False
xml.setRequestHeader "Content-Type", "application/json"
xml.setRequestHeader "Accept", "application/json"
If postParameters <> "" Then
xml.send (postParameters)
Else
xml.send
End If
pResponseText = xml.ResponseText
request = pResponseText
Select Case format
Case Json
SetJson
End Select
End Function
Private Sub SetJson()
Dim qt As String
qt = """"
Set pScriptControl = CreateObject("scriptcontrol")
pScriptControl.Language = "JScript"
pScriptControl.eval "var obj=(" & pResponseText & ")"
'pScriptControl.ExecuteStatement "var rootObj = null"
pScriptControl.AddCode "function getObject(){return obj;}"
'pScriptControl.eval "var rootObj=obj[" & qt & "query" & qt & "]"
pScriptControl.AddCode "function getRootObject(){return rootObj;}"
pScriptControl.AddCode "function getCount(){ return rootObj.length;}"
pScriptControl.AddCode "function getBaseValue(){return baseValue;}"
pScriptControl.AddCode "function getValue(){ return arrayValue;}"
Set pResponseJson = pScriptControl.Run("getObject")
End Sub
Public Function setJsonRoot(rootPath As String)
If rootPath = "" Then
pScriptControl.ExecuteStatement "rootObj = obj"
Else
pScriptControl.ExecuteStatement "rootObj = obj." & rootPath
End If
Set setJsonRoot = pScriptControl.Run("getRootObject")
End Function
Public Function getJsonObjectCount()
getJsonObjectCount = pScriptControl.Run("getCount")
End Function
Public Function getJsonObjectValue(path As String)
pScriptControl.ExecuteStatement "baseValue = obj." & path
getJsonObjectValue = pScriptControl.Run("getBaseValue")
End Function
Public Function getJsonArrayValue(index, key As String)
Dim qt As String
qt = """"
If InStr(key, ".") > 0 Then
arr = Split(key, ".")
key = ""
For Each cKey In arr
key = key + "[" & qt & cKey & qt & "]"
Next
Else
key = "[" & qt & key & qt & "]"
End If
Dim statement As String
statement = "arrayValue = rootObj[" & index & "]" & key
pScriptControl.ExecuteStatement statement
getJsonArrayValue = pScriptControl.Run("getValue", index, key)
End Function
Public Property Get ResponseText() As String
ResponseText = pResponseText
End Property
Public Property Get ResponseJson()
ResponseJson = pResponseJson
End Property
Public Property Get ScriptControl() As Object
ScriptControl = pScriptControl
End Property
Example Usage (from ThisWorkbook):
Sub Example()
Dim j
'clear current range
Range("A2:A1000").ClearContents
'create ajax object
Set j = New Json
'make yql request for json
j.request "https://query.yahooapis.com/v1/public/yql?q=show%20tables&format=json&callback=&diagnostics=true"
'Debug.Print j.ResponseText
'set root of data
Set obj = j.setJsonRoot("query.results.table")
Dim index
'determine the total number of records returned
index = j.getJsonObjectCount
'if you need a field value from the object that is not in the array
'tempValue = j.getJsonObjectValue("query.created")
Dim x As Long
x = 2
If index > 0 Then
For i = 0 To index - 1
'set cell to the value of content field
Range("A" & x).value = j.getJsonArrayValue(i, "content")
x = x + 1
Next
Else
MsgBox "No items found."
End If
End Sub