i used chromedriver but its slowly,i tried webbrowser but not worked.
My webpage is;
**https://coinmarketcap.com/converter/btc/usd/?amt=1 **
so
i want get of how much usd one bitcoin or more then one
Coinmarketcap uses it's own API service. You can use their API instead of using web page. Dont forget to add Newtonsoft library to your project from Nuget.
Dim btcAmount = 4
Dim tempcookies As New CookieContainer
Dim encoding As New UTF8Encoding
Dim postreq As HttpWebRequest = DirectCast(HttpWebRequest.Create("https://api.coinmarketcap.com/data-api/v3/tools/price-conversion?amount=" & btcAmount & "&convert_id=2781&id=1"), HttpWebRequest)
postreq.Method = "GET"
postreq.KeepAlive = True
postreq.CookieContainer = tempcookies
postreq.UserAgent = "Mozilla/5.0 (Windows; U; Windows NT 6.1; ru; rv:1.9.2.3) Gecko/20100401 Firefox/4.0 (.NET CLR 3.5.30729"
postreq.ContentType = "application/x-www-form-urlencoded"
postreq.Referer = "https://coinmarketcap.com"
Dim postresponse As HttpWebResponse
postresponse = DirectCast(postreq.GetResponse, HttpWebResponse)
tempcookies.Add(postresponse.Cookies)
Dim postreqreader As New StreamReader(postresponse.GetResponseStream())
Dim result As String = postreqreader.ReadToEnd
Dim json As JObject = JObject.Parse(result)
MessageBox.Show(json.Item("data").Item("quote")(0).Item("price"))
Related
I need to get the EUR price from json source API page https://api.coingecko.com/api/v3/coins/axie-infinity which is in some kind of 'tree' results.
The Rank market_cap_rank I'm able to get but current_price I'm not able.
My Code:
Public Class JsonResponse
<JsonProperty("market_cap_rank")>
Public Property _rank As String
<JsonProperty("current_price")>
Public Property _cPrice As String
End Class
Public Sub getRankAXS()
Try
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
ServicePointManager.Expect100Continue = True
Dim _urlAXS As String = "https://api.coingecko.com/api/v3/coins/axie-infinity" '&format=json"
Dim _req As System.Net.HttpWebRequest = System.Net.HttpWebRequest.Create(_urlAXS)
_req.Proxy = Nothing
_req.UserAgent = "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/98.0.4758.81 Safari/537.36"
Dim _resp As System.Net.HttpWebResponse = _req.GetResponse
Dim streamReader As System.IO.StreamReader = New System.IO.StreamReader(_resp.GetResponseStream())
Dim rank_source As String = streamReader.ReadToEnd
Dim _rankResults = JsonConvert.DeserializeObject(Of JsonResponse)(rank_source)
Dim vRank = _rankResults._rank
Dim vPrice = _rankResults._cPrice
Dim row As DataGridViewRow = Nothing
For Each item As DataGridViewRow In dgvMain.Rows
row = item
dgvMain.Rows(17).Cells(0).Value = vRank
dgvMain.Rows(17).Cells(4).Value = vPrice
Next
dgvMain.Refresh()
_runningThreads.Remove(Thread.CurrentThread)
Catch ex As Exception
End Try
End Sub
The Source in short:
"country_origin": "",
"genesis_date": null,
"contract_address": "0xbb0e17ef65f82ab018d8edd776e8dd940327b28b",
"sentiment_votes_up_percentage": 86.04,
"sentiment_votes_down_percentage": 13.96,
"market_cap_rank": 35,
"coingecko_rank": 282,
"coingecko_score": 34.249,
"developer_score": 0.0,
"community_score": 12.533,
"liquidity_score": 74.834,
"public_interest_score": 4.85,
"market_data": {
"current_price": {
"aed": 253.89,
"dot": 3.081598,
"eos": 26.36419,
"eth": 0.022493,
"eur": 60.44,
"gbp": 51.16,
}
}
"total_value_locked": null,
"mcap_to_tvl_ratio": null,
"fdv_to_tvl_ratio": null,
"roi": null,
SO under _cPrice I need to get the =>market_data => current_price => eur
Thank you for help.
Visual Studio has a cool feature called Paste JSON as Classes that can be found under Edit > Paste Special > Paste JSON as Classes. I cannot paste the example because the incoming payload is too large.
However, once you get the classes defined, you can then deserialize the object using the following:
Dim payload = JsonConvert.DeserializeObject(Of Rootobject)(rank_source)
Dim eurMarketDataCurrentPrice = payload.market_data.current_price.eur
Fiddle: https://dotnetfiddle.net/moVuMl
I'm trying to parse property information from this link which produces a JSON response. I've used here JSON and VBA converter. However, when I run the script below, I get an error keyNotFoundError. I'm trying to parse the value of properties which is within features.
Public Sub parseJson()
Dim jsonObject As Object, oElem As Variant
Dim resp$, Url$, R&
Url = "https://torontolife.com/wp-content/themes/sjm-underscores/inc/neighbourhoods/2015/compiled.json"
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", Url, False
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/88.0.4324.182 Safari/537.36"
.send
resp = .responseText
End With
Set jsonObject = JsonConverter.parseJson(resp)
For Each oElem In jsonObject("features")
Debug.Print oElem("properties")
Next oElem
End Sub
I also get the same error when I try to like the following:
Sub Demo()
Dim Json As Object
JsonString = "[{""Entries"":[{""Name"": ""SMTH"",""Gender"": ""Male""}]}]"
JsonConverter.JsonOptions.AllowUnquotedKeys = True
Set Json = JsonConverter.ParseJson(JsonString)
Debug.Print Json(1)("Entries")
End Sub
I'm on Windows 7 (32 bit) and I'm using this library.
One more thing, they are valid JSON and I didn't encounter any error while parsing the same using Python.
Your code should be failing because oElem("properties") is a dictionary. Furthermore, within that dictionary there are a mixture of datatypes associated with the keys so you will need to test the type and handle appropriately. Or use one of the many readily available programs which will handle that and empty the entire json object for you.
Option Explicit
Public Sub ParseJson()
Dim jsonObject As Object, oElem As Variant
Dim resp$, Url$, R&
Url = "https://torontolife.com/wp-content/themes/sjm-underscores/inc/neighbourhoods/2015/compiled.json"
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", Url, False
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/88.0.4324.182 Safari/537.36"
.send
resp = .responseText
End With
Set jsonObject = JsonConverter.ParseJson(resp)
Dim key As Variant, propertyTypes As Scripting.Dictionary
Set propertyTypes = New Scripting.Dictionary
For Each oElem In jsonObject("features")
For Each key In oElem("properties")
Debug.Print key, vbTab, TypeName(oElem("properties")(key))
propertyTypes(key) = TypeName(oElem("properties")(key))
Next
Next oElem
'Review propertyTypes dict and/or immediate window print out
Stop
End Sub
I have to pull information from a MURAL board (design thinking tool, which is pretty much an online whiteboard). I need to pull the following information for the stickies:
https://app.mural.co/t/hanno1/m/hanno1/1488557783266/465baa38d35e95edc969a5ca9e2a8bb8b6f10310
Sticky Note Text
Sticky Note Attributes (Color, Size, Shape)
Sticky Note Location
Image links (and locations if possible)
I have created code that is not working. Nothing is being pulled. It pretty much skips straight from opening to quitting the browser.
Also how do I pull the actual HTML code to find the attributes/location?
Option Explicit
Public Sub GetInfo()
Dim ie As InternetExplorer, arr(), col
Set ie = New InternetExplorer
Set col = New Collection
With ie
.Visible = True
.navigate "https://app.mural.co/t/nextgencomms9753/m/nextgencomms9753/1536712668215/cd70107230d7f406058157a3bb8e951cedc9afc0"
While .Busy Or .readyState < 4: DoEvents: Wend
Dim listedItems As Object, item As Object, prices As Object, price As Object, j As Long
Set listedItems = .document.getElementsByClassName("widget-layer-inner")
For Each item In listedItems
Set prices = item.getElementsByClassName("Linkify")
ReDim arr(0 To prices.Length - 1) 'you could limit this after by redim to 0 to 0
j = 0
For Each price In prices
arr(j) = price.innerText
j = j + 1
Next
col.Add Array(item.getElementsByClassName("widgets-container") (0).innerText, arr)
Next
.Quit
Dim item2 As Variant, rowNum As Long
For Each item2 In col
rowNum = rowNum + 1
With ThisWorkbook.Worksheets("Sheet1")
.Cells(rowNum, 1) = Replace$(Trim$(item2(0)), Chr$(10), Chr$(32))
.Cells(rowNum, 2).Resize(1, UBound(item2(1)) + 1) = item2(1)
End With
Next
End With
End Sub
In general, I think using IE automation should be avoided where possible, especially if you can figure out a method to emulate this request via a web request.
A little background on this method
I'm submitting two web requests. One to get an authorization token, and another to get the the JSON from the page which populate the widgets on screen. I figured this out by studying the web requests sent back and forth between the client (me) and the server, and emulated those requests.The approach outlined below is pretty fast, about 2 seconds without URL decoding, and 10 seconds with decoding.
Things you'll need for this to work
Explicit Reference set to Microsoft XML v6.0
Explicit Reference set to Microsoft Scripting Runtime
The VBA-JSON project included into your project, get that here
Code
I split out token and json retrieval into two functions. What you get back from getJSON is a dictionary. This dictionary is somewhat nested, so you refer to items by key to traverse the dictionary down. E.g. MyDict(property1)(childPropertyOfproperty1)(childPropertyOf...) etc.
Here's the code.
Option Explicit
Public Sub SubmitRequest()
Const URL As String = "https://app.mural.co/t/hanno1/m/hanno1/1488557783266/465baa38d35e95edc969a5ca9e2a8bb8b6f10310"
Dim returnobject As Object
Dim widgets As Object
Dim widget As Variant
Dim WidgetArray As Variant
Dim id As String
Dim i As Long
Set returnobject = getJSON(URL, getToken(URL))
Set widgets = returnobject("widgets")
ReDim WidgetArray(0 To 7, 0 To 10000)
For Each widget In widgets
'Only add if a text item, change if you like
If returnobject("widgets")(widget)("type") = "murally.widget.TextWidget" Then
WidgetArray(0, i) = URLDecode(returnobject("widgets")(widget)("properties")("text"))
WidgetArray(1, i) = returnobject("widgets")(widget)("properties")("fontSize")
WidgetArray(2, i) = returnobject("widgets")(widget)("properties")("backgroundColor")
WidgetArray(3, i) = returnobject("widgets")(widget)("x")
WidgetArray(4, i) = returnobject("widgets")(widget)("y")
WidgetArray(5, i) = returnobject("widgets")(widget)("width")
WidgetArray(6, i) = returnobject("widgets")(widget)("height")
WidgetArray(7, i) = returnobject("widgets")(widget)("id")
i = i + 1
End If
Next
ReDim Preserve WidgetArray(0 To 7, i - 1)
With ThisWorkbook.Worksheets("Sheet1")
.Range("A1:H1") = Array("Text", "FontSize", "BackgroundColor", "X Position", "Y Position", "Width", "Height", "ID")
.Range(.Cells(2, 1), .Cells(i+ 1, 8)).Value = WorksheetFunction.Transpose(WidgetArray)
End With
End Sub
Public Function getJSON(URL As String, Token As String) As Object
Dim baseURL As String
Dim getRequest As MSXML2.XMLHTTP60
Dim URLParts As Variant
Dim jsonconvert As Object
Dim id As String
dim user as String
URLParts = Split(URL, "/", , vbBinaryCompare)
id = URLParts(UBound(URLParts) - 1)
user = URLParts(UBound(URLParts) - 2)
baseURL = Replace(Replace("https://app.mural.co/api/murals/{user}/{ID}", "{ID}", id), "{user}", user)
Set getRequest = New MSXML2.XMLHTTP60
With getRequest
.Open "GET", baseURL
.setRequestHeader "Authorization", "Bearer " & Token
.setRequestHeader "Referer", URL
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:64.0) Gecko/20100101 Firefox/64.0"
.send
Set getJSON = JsonConverter.ParseJson(.responseText)
End With
End Function
Public Function getToken(URL As String) As String
Dim getRequest As MSXML2.XMLHTTP60
Dim URLParts As Variant
Dim position As Long
Dim jsonconvert As Object
Dim Token As Object
Dim State As String
Dim User As String
Dim json As String
Dim referer As String
Dim id As String
Dim posturl As String
json = "{""state"": ""{STATE}""}"
posturl = "https://app.mural.co/api/v0/visitor/{user}.{ID}"
referer = "https://app.mural.co/t/{user}/m/{user}/{ID}"
URLParts = Split(URL, "/", , vbBinaryCompare)
position = InStrRev(URL, "/")
URL = Left$(URL, position - 1)
State = URLParts(UBound(URLParts))
id = URLParts(UBound(URLParts) - 1)
User = URLParts(UBound(URLParts) - 2)
json = Replace(json, "{STATE}", State)
posturl = Replace(Replace(posturl, "{user}", User), "{ID}", id)
referer = Replace(Replace(referer, "{user}", User), "{ID}", id)
Set getRequest = New MSXML2.XMLHTTP60
With getRequest
.Open "POST", posturl
.setRequestHeader "origin", "https://app.mural.co"
.setRequestHeader "Referer", referer
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:64.0) Gecko/20100101 Firefox/64.0"
.setRequestHeader "Content-Type", "application/json; charset=utf-8"
.send json
Set jsonconvert = JsonConverter.ParseJson(.responseText)
End With
getToken = jsonconvert("token")
End Function
' from https://stackoverflow.com/a/12804172/4839827
Public Function URLDecode(ByVal StringToDecode As String) As String
With CreateObject("htmlfile")
.Open
.Write StringToDecode
.Close
URLDecode = .body.outerText
End With
End Function
Here's the output returned. There are other properties available, however this code is meant to just give you an idea how to pull this back.
I've tried this so far:
Dim wreq As HttpWebRequest = WebRequest.Create("http://www.nasdaq.com/symbol/goog/financials?query=income-statement&data=quarterly")
wreq.UserAgent = "Mozilla/5.0 (Windows; U; Windows NT 6.1; en-US; rv:1.9.1.5) Gecko/20091102 Firefox/3.5.5"
wreq.Method = "get"
Dim prox As IWebProxy = wreq.Proxy
prox.Credentials = CredentialCache.DefaultCredentials
Dim document As New HtmlAgilityPack.HtmlDocument
Dim web As New HtmlAgilityPack.HtmlWeb
web.UseCookies = True
web.PreRequest = New HtmlAgilityPack.HtmlWeb.PreRequestHandler(AddressOf onPreReq)
wreq.CookieContainer = cookies
Dim res As HttpWebResponse = wreq.GetResponse()
document.Load(res.GetResponseStream, True)
Debug.WriteLine(document.DocumentNode.OuterHtml)
But it returns the HTML for this web address: http://www.nasdaq.com/symbol/goog/financials?query=income-statement
Instead of this one: http://www.nasdaq.com/symbol/goog/financials?query=income-statement&data=quarterly
What am I doing wrong?
Additional Info
Here is onPreReq
Private Function onPreReq(req As HttpWebRequest)
req.CookieContainer = cookies
Return True
End Function
The problem was with my variable Ticker. It contains the ticker symbols that I use to create the web addresses. I have been using all caps (ex. GOOG) up to this point. I've changed all of my tickers to lower case (ex. goog) and that seems to have done the trick.
I am trying to access the smartsheet API. They have a sample code provided in curl to access it.
To access your Sheet list, construct an HTTPS request using your favorite programming or scripting language. Here is an example using the curl from a linux command line:
curl https://api.smartsheet.com/1.0/sheets \
-H "Authorization: Bearer 0da6cf0d-848c-4266-9b47-cd32a6151b1f" \
-H "Assume-User: john.doe%40smartsheet.com"
How do I do that in vb.net or from a html form?
This is a rather large subject but at it's most simple you could try this...
Imports System.Net
and then...
Dim wHeader As WebHeaderCollection = New WebHeaderCollection()
wHeader.Clear()
wHeader.Add("Authorization: Bearer 0da6cf0d-848c-4266-9b47-cd32a6151b1f")
wHeader.Add("Assume-User: john.doe%40smartsheet.com")
Dim sUrl As String = "https://api.smartsheet.com/1.0/sheets"
Dim wRequest As HttpWebRequest = DirectCast(System.Net.HttpWebRequest.Create(sUrl), HttpWebRequest)
'wRequest.ContentType = "application/json" ' I don't know what your content type is
wRequest.Headers = wHeader
wRequest.Method = "GET"
Dim wResponse As HttpWebResponse = DirectCast(wRequest.GetResponse(), HttpWebResponse)
Dim sResponse As String = ""
Using srRead As New StreamReader(wResponse.GetResponseStream())
sResponse = srRead.ReadToEnd()
End Using
I'm unfamiliar with the smartsheet API but you can use this as a start point.
If you are using a Proxy you will need to add...
Dim wProxy As IWebProxy = WebRequest.GetSystemWebProxy()
wProxy.Credentials = System.Net.CredentialCache.DefaultCredentials
and specify the proxy when you make the request...
wRequest.Proxy = wProxy
To create a web request in VB.Net, you can use the HttpWebRequest class.
The -H argument in curl creates an extra header. To add headers to a HttpWebRequest you simply add them to the WebHeaderCollection Headers.
Example:
Dim myHttpWebRequest = CType(WebRequest.Create("https://api.smartsheet.com/1.0/sheets"), HttpWebRequest)
myHttpWebRequest.Headers.Add("Authorization: Bearer 0da6cf0d-848c-4266-9b47-cd32a6151b1f")
myHttpWebRequest.Headers.Add("Assume-User: john.doe%40smartsheet.com")
Dim myHttpWebResponse = CType(myHttpWebRequest.GetResponse(), HttpWebResponse)
use the example and it worked perfectly for me, some changes. I leave you the example.
Dim wHeader As WebHeaderCollection = New WebHeaderCollection()
wHeader.Clear()
wHeader.Add("Authorization: Bearer eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9")
wHeader.Add("Assume-User: g.n.moran%gmail.com")
Dim wRequest As HttpWebRequest = DirectCast(System.Net.HttpWebRequest.Create(url), HttpWebRequest)
wRequest.Headers = wHeader
wRequest.Method = "POST"
Dim byteArray As Byte() = Encoding.UTF8.GetBytes(json)
wRequest.ContentType = "application/json"
wRequest.ContentLength = byteArray.Length
Dim dataStream As Stream = wRequest.GetRequestStream()
dataStream.Write(byteArray, 0, byteArray.Length)
dataStream.Close()
dataStream.Dispose()
ServicePointManager.Expect100Continue = False
Dim wResponse As HttpWebResponse = DirectCast(wRequest.GetResponse(), HttpWebResponse)
oerror.Codigo = CType(wResponse, HttpWebResponse).StatusCode
oerror.Descripcion = CType(wResponse, HttpWebResponse).StatusDescription
Dim responseFromServer As String = ""
dataStream = wResponse.GetResponseStream()
Dim reader As New StreamReader(dataStream)
Using srRead As New StreamReader(wResponse.GetResponseStream())
responseFromServer = srRead.ReadToEnd()
End Using