Excel VBA geocoding response invalid - google-maps

I use this script to get geocodes for any address in germany:
Public Function getGoogleMapsGeocode(sAddr As String) As String
Dim xhrRequest As XMLHTTP60
Dim sQuery As String
Dim domResponse As DOMDocument60
Dim ixnStatus As IXMLDOMNode
Dim ixnLat As IXMLDOMNode
Dim ixnLng As IXMLDOMNode
' Use the empty string to indicate failure
getGoogleMapsGeocode = ""
Set xhrRequest = New XMLHTTP60
sQuery = "http://maps.googleapis.com/maps/api/geocode/xml?sensor=false&address="
sQuery = sQuery & Replace(sAddr, " ", "+")
xhrRequest.Open "GET", sQuery, True
xhrRequest.send
Set domResponse = New DOMDocument60
domResponse.LoadXML xhrRequest.responseText
Set ixnStatus = domResponse.SelectSingleNode("//status")
If (ixnStatus.Text <> "OK") Then
'Exit Function
End If
Set ixnLat = domResponse.SelectSingleNode("/GeocodeResponse/result/geometry/location/lat")
Set ixnLng = domResponse.SelectSingleNode("/GeocodeResponse/result/geometry/location/lng")
getGoogleMapsGeocode = ixnLat.Text & ", " & ixnLng.Text
End Function
When I type the query string into the browser it returns a valid xml response with the geocodes. If I let vba do it, I get an error. Is there something I should know?
responseText :
"<?xml version="1.0" encoding="UTF-8"?>
<GeocodeResponse>
<status>INVALID_REQUEST</status>
</GeocodeResponse>
" : String : Modul8.getGoogleMapsGeocode

Related

How to convert string to json vb.net

this is the code i have, dim sline from string to json, i have try it and search on google, but i havent done yet...
please help
Dim sURL As String
sURL = TextBox1.Text
Dim wrGETURL As WebRequest
wrGETURL = WebRequest.Create(sURL)
Dim myProxy As New WebProxy("myproxy", 80)
myProxy.BypassProxyOnLocal = True
wrGETURL.Proxy = myProxy
wrGETURL.Proxy = WebProxy.GetDefaultProxy()
Dim objStream As Stream
objStream = wrGETURL.GetResponse.GetResponseStream()
Dim objReader As New StreamReader(objStream)
Dim sLine As String = ""
Dim i As Integer = 0
Do While Not sLine Is Nothing
i += 1
sLine = objReader.ReadLine
If Not sLine Is Nothing Then
Console.WriteLine("{0}:{1}", i, sLine)
End If
Loop
Dim respon As Array = sLine.ToArray()
Console.ReadLine()
Console.WriteLine(respon("traceNo"))
Console.ReadLine()
i want to convert the Dim sline to json, how it possible?
Newtonsoft.JSON is a VERY handy NuGet to easy use JSON in VB.Net.
Seperate your lines into a List(Of Integer, String) (i,sLine)
and Serialize it with
Dim yourJSONString = JsonConvert.SerializeObject(yourList)

How can I handle parsed JSON property/value not existing in VB.Net?

I shall get to the point and it is probably an easy answer for someone. The JSON being returned from HubSpot may or may not include a property such as phone and address because it is not filled out in HubSpot. This causes an error in the For Each block below:
System.NullReferenceException
HResult=0x80004003
Message=Object reference not set to an instance of an object.
Source=HubSpotGetAllCompanies
How can I handle it so that if there is no property for telephone for example, I can put in a DBNull value instead.
Thanks in advance!
Imports System.ComponentModel
Imports System.IO
Imports System.Net
Imports Newtonsoft.Json
Imports Newtonsoft.Json.Linq
Module Index
Sub Main()
Dim counter = 0
Dim offset As String = String.Empty
Dim hasmore As Boolean = False
Dim hapikey = "xxx"
Dim hubSpot As New Dal.HubSpot.Pull
'Create Table
Dim companiesTable As DataTable = New DataTable()
companiesTable.Columns.Add("PortalID")
companiesTable.Columns.Add("CompanyID")
companiesTable.Columns.Add("Company")
companiesTable.Columns.Add("Website")
companiesTable.Columns.Add("Address1")
companiesTable.Columns.Add("City")
companiesTable.Columns.Add("Country")
companiesTable.Columns.Add("Postcode")
companiesTable.Columns.Add("Telephone")
companiesTable.Columns.Add("Ref")
companiesTable.Columns.Add("VatCode")
'Create Values
'Loop as you can only return so many companies at once (250 is limit I believe)
Do
Dim url As String = String.Format("https://api.hubapi.com/companies/v2/companies/paged?hapikey={0}&properties=name&properties=website&properties=address&properties=city&properties=country&properties=zip&properties=phone&limit=10{1}", hapikey, offset)
Dim httpWebRequest = CType(WebRequest.Create(url), HttpWebRequest)
httpWebRequest.ContentType = "application/json"
httpWebRequest.Method = "GET"
Dim httpResponse = CType(httpWebRequest.GetResponse(), HttpWebResponse)
Using streamReader = New StreamReader(httpResponse.GetResponseStream())
Dim result = streamReader.ReadToEnd()
Dim jObject As JObject = JObject.Parse(result)
Dim jhasmore As JToken = jObject("has-more")
Dim joffset As JToken = jObject("offset")
Dim jcompanies As JToken = jObject("companies")
If jhasmore.ToString().ToLower() = "true" Then
hasmore = True
Else
hasmore = False
End If
offset = String.Format("&offset={0}", joffset.ToString())
For Each item In jcompanies.ToList()
Dim portalId = item("portalId").ToString()
Dim companyId = item("companyId").ToString()
Dim company = item("properties")("name")("value").ToString()
Dim website = If(item("properties")("website")("value").ToString(), DBNull.Value)
Dim address1 = If(item("properties")("address")("value").ToString(), DBNull.Value)
Dim city = If(item("properties")("city")("value").ToString(), DBNull.Value)
Dim country = If(item("properties")("country")("value").ToString(), DBNull.Value)
Dim postcode = If(item("properties")("zip")("value").ToString(), DBNull.Value)
Dim telephone = If(item("properties")("phone")("value").ToString(), DBNull.Value)
Dim ref = DBNull.Value
Dim vatCode = DBNull.Value
companiesTable.Rows.Add(portalId, companyId, company, website, address1, city, country, postcode, telephone, ref, vatCode)
Next
End Using
counter += 1
Loop While hasmore
hubSpot.GetAllHubSpotCompanies(companiesTable)
End Sub
Try using the Null Propagation Operator ? between any token accessors that may not be filled:
Dim telephone = If(item("properties")("phone")?("value").ToString(), DBNull.Value)
If a particular token is Nothing, it will return Nothing to the If and set the variable to DBNull.Value

Get /Put Device Alias using Teamviewer REST API

Im looking to get a list of all the devices on my work admin teamviewer account using vb.net. I would also like to be able to change the "Alias" of a given device using it's device id. i know very little about API's. i found the following example but i am not sure how to adapt it to get the json response.
instead of the accesstoken, i believe i need to use the client id and secret id along with the authorization code in order to use this. if i run it in it's current start i get a 401 unauthorized error. Any help would be appreciated.
i also have no idea how to use "PUT" to change the Alias using the device id which will both be entered in textboxes. ex alias = textbox1.text and device_id = textbox2.text
Private Sub SurroundingSub()
Dim accessToken As String = "xxxxxxxxxxxxxxxxxxx"
Dim apiVersion As String = "v1"
Dim tvApiBaseUrl As String = "https://webapi.teamviewer.com"
Dim address As String = tvApiBaseUrl & "/api/" & apiVersion & "/devices"
Try
Dim request As HttpWebRequest = TryCast(WebRequest.Create(address), HttpWebRequest)
request.Headers.Add("Bearer", accessToken)
request.Method = "GET"
Dim webResp As WebResponse = request.GetResponse()
Catch __unusedException1__ As Exception
msgbox(__unusedException1__.ToString)
End Try
End Sub
Here is the Get all devices code:
Private Sub get_teamviewer_devices()
Dim accessToken As String = "XXXXXXXXXXXXXXXXXXXXX"
Dim apiVersion As String = "v1"
Dim tvApiBaseUrl As String = "https://webapi.teamviewer.com"
Dim address As String = tvApiBaseUrl & "/api/" & apiVersion & "/devices"
Dim result_json As String = Nothing
Try
Dim request As HttpWebRequest = TryCast(WebRequest.Create(address), HttpWebRequest)
request.Headers.Add("Authorization", "Bearer " & accessToken)
request.Method = "GET"
Dim webResp As WebResponse = request.GetResponse()
Using reader = New StreamReader(webResp.GetResponseStream)
result_json = reader.ReadToEnd()
End Using
TextBox1.Text = result_json
Catch __unusedException1__ As Exception
MsgBox(__unusedException1__.ToString)
End Try
End Sub
Here is the PUT portion to change an alias:
Public Sub change_alias(ByVal device_id As String, ByVal alias_str As String)
Dim accessToken As String = "XXXXXXXXXXXXXXXXXXXXX"
Dim apiVersion As String = "v1"
Dim tvApiBaseUrl As String = "https://webapi.teamviewer.com"
Dim address As String = tvApiBaseUrl & "/api/" & apiVersion & "/devices/" & device_id
Dim result As String
Dim alias_str_ As String = Chr(34) & alias_str & Chr(34)
Try
Dim request As HttpWebRequest = TryCast(WebRequest.Create(address), HttpWebRequest)
request.Headers.Add("Authorization", "Bearer " & accessToken)
request.Method = "PUT"
request.ContentType = "application/json"
Using requestWriter2 As New StreamWriter(request.GetRequestStream())
requestWriter2.Write("{""Alias"" : " & alias_str_ & "}")
End Using
Dim webResp As WebResponse = request.GetResponse()
Using reader = New StreamReader(webResp.GetResponseStream)
result = reader.ReadToEnd()
End Using
TextBox1.Text = (result)
Catch __unusedException1__ As Exception
MsgBox(__unusedException1__.ToString)
End Try
End Sub

iTextSharp Error in Parsing

Sorry for being newbie on this . But Im having an error when it comes to parsing part of my codes.Please help me. The version of my itextsharp is version 4.1.6
Unable to cast object of type 'iTextSharp.text.html.simpleparser.IncTable' to type 'iTextSharp.text.IElement'.
this is my vb codes:
Dim strHTMLContent As StringBuilder = New StringBuilder()
Dim strFinalHTML As String
Dim output = New MemoryStream()
Dim document = New iTextSharp.text.Document(PageSize.A4, 50, 50, 25, 25)
Dim dsRcpComp As New DataSet
Dim dtDetails As New DataTable
Dim RecipeName As String = ""
Dim RecipeIngredients As String = ""
dsRcpComp = GetRcpCompStandard(conStr, CodeListe, CodeTrans)
dtDetails = dsRcpComp.Tables(0)
RecipeName = Replace(dtDetails.Rows(0).Item("Name"), vbCr, "<br>")
RecipeIngredients = Replace(dtDetails.Rows(0).Item("Ingredients"), vbCr, "<br>")
strHTMLContent.Append("<table width=700 align='center' Border='0' cellspacing='50' fontsize='1' class='pdfFont'")
strHTMLContent.Append("<tr>")
'*** GERMAN COLUMN ***
strHTMLContent.Append("<td valign=top><table width=210 align='left'>")
strHTMLContent.Append("<tr><td><font size='2' >" & RecipeName & "</font></td></tr>")
strHTMLContent.Append("<tr><td></td></tr>")
strHTMLContent.Append("<tr><td>")
strHTMLContent.Append(RecipeIngredients & "<br><br>")
strHTMLContent.Append("</td></tr>")
strHTMLContent.Append("</tr></table>")
Dim styles As StyleSheet = New StyleSheet
styles.LoadStyle("pdfFont", "face", "courier")
strFinalHTML = Replace(strHTMLContent.ToString, "& ", "& ")
document.SetPageSize(iTextSharp.text.PageSize.A4.Rotate())
Dim parsedHtmlElements = HTMLWorker.ParseToList(New StringReader(strFinalHTML), styles)
Dim writer = PdfWriter.GetInstance(document, output)
document.Open()
For Each htmlElement In parsedHtmlElements
document.Add(TryCast(htmlElement, IElement))
Next
document.Close()
Return output
I'm getting the error in this line:
Dim parsedHtmlElements = HTMLWorker.ParseToList(New StringReader(strFinalHTML), styles)

Bitfinex API with VBnet

Here is what I've come up with so far:
Sub GetData()
Try
Dim method As String = calldata("/balances")
MsgBox(method)
Catch ex As Exception
End Try
End Sub
Function calldata(ByVal Method As String) As String
Dim logincookie As CookieContainer
Try
Dim pKey As String = "CODE HERE"
Dim sKey As String = "SECRET CODE HERE"
Dim postReq As HttpWebRequest = DirectCast(WebRequest.Create("https://api.bitfinex.com/v1/"), HttpWebRequest)
Dim randomn As String = CLng(DateTime.UtcNow.Subtract(New DateTime(1970, 1, 1)).TotalSeconds)
'//Dependant upon Method
Dim postData As String = "method=" & Method & "&nonce=" & randomn
Dim tempcookies As New CookieContainer
'//Start Encryption
Dim KeyByte() As Byte = Encoding.ASCII.GetBytes(sKey)
Dim HMAcSha As New HMACSHA384(Encoding.ASCII.GetBytes(sKey))
Dim messagebyte() As Byte = Encoding.ASCII.GetBytes(postData)
Dim hashmessage() As Byte = HMAcSha.ComputeHash(messagebyte)
Dim Sign As String = BitConverter.ToString(hashmessage)
Sign = Sign.Replace("-", "")
'//Generate Post Information
postReq.Method = "POST"
postReq.KeepAlive = False
postReq.Headers.Add("X-BFX-APIKEY", pKey)
postReq.Headers.Add("X-BFX-PAYLOAD")
postReq.Headers.Add("X-BFX-SIGNATURE", LCase(Sign))
postReq.CookieContainer = tempcookies
postReq.ContentType = "application/x-www-form-urlencoded"
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.ContentLength = messagebyte.Length
'//Send Request
System.Net.ServicePointManager.Expect100Continue = False
Dim postreqstream As Stream = postReq.GetRequestStream()
postreqstream.Write(messagebyte, 0, messagebyte.Length)
postreqstream.Close()
Dim postresponse As HttpWebResponse
postresponse = DirectCast(postReq.GetResponse(), HttpWebResponse)
tempcookies.Add(postresponse.Cookies)
logincookie = tempcookies
Dim postreqreader As New StreamReader(postresponse.GetResponseStream())
'The Response Text
Dim thepage As String = postreqreader.ReadToEnd
thepage = thepage.Replace(Chr(34), Chr(39))
Return thepage
Catch
Return False
End Try
End Function
I can't figure out the payload portion. This script is a modified version of what I'm using for other API's. Here is the Bitfinex API info
https://www.bitfinex.com/pages/api
Is everything right except pay load? How do I complete "payload = parameters-dictionary -> JSON encode -> base64" portion of the API details?
Try this.
Sub GetData()
Try
Dim method As String = calldata("/balances")
MsgBox(method)
Catch ex As Exception
End Try
End Sub
Function calldata(ByVal Method As String) As String
Dim logincookie As CookieContainer
Try
Dim pKey As String = "CODE HERE"
Dim sKey As String = "SECRET CODE HERE"
Dim postReq As HttpWebRequest = DirectCast(WebRequest.Create("https://api.bitfinex.com/v1/balances"), HttpWebRequest)
Dim randomn As String = CLng(DateTime.UtcNow.Subtract(New DateTime(1970, 1, 1)).TotalSeconds)
'//Dependant upon Method
Dim postData As String = "{""request"": ""/v1" & Method & """,""nonce"": """ & randomn & """,""options"":{}}"
Dim tempcookies As New CookieContainer
Dim payload As String = Convert.ToBase64String(Encoding.UTF8.GetBytes(postData))
'//Start Encryption
Dim KeyByte() As Byte = Encoding.ASCII.GetBytes(sKey)
Dim HMAcSha As New HMACSHA384(Encoding.ASCII.GetBytes(sKey))
Dim messagebyte() As Byte = Encoding.ASCII.GetBytes(payload)
Dim hashmessage() As Byte = HMAcSha.ComputeHash(messagebyte)
Dim Sign As String = BitConverter.ToString(hashmessage)
Sign = Sign.Replace("-", "")
'//Generate Post Information
postReq.Method = "POST"
postReq.KeepAlive = False
postReq.Headers.Add("X-BFX-APIKEY", pKey)
postReq.Headers.Add("X-BFX-PAYLOAD", payload)
postReq.Headers.Add("X-BFX-SIGNATURE", LCase(Sign))
postReq.CookieContainer = tempcookies
postReq.ContentType = "application/x-www-form-urlencoded"
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.ContentLength = messagebyte.Length
'//Send Request
System.Net.ServicePointManager.Expect100Continue = False
Dim postreqstream As Stream = postReq.GetRequestStream()
postreqstream.Write(messagebyte, 0, messagebyte.Length)
postreqstream.Close()
Dim postresponse As HttpWebResponse
postresponse = DirectCast(postReq.GetResponse(), HttpWebResponse)
tempcookies.Add(postresponse.Cookies)
logincookie = tempcookies
Dim postreqreader As New StreamReader(postresponse.GetResponseStream())
'The Response Text
Dim thepage As String = postreqreader.ReadToEnd
thepage = thepage.Replace(Chr(34), Chr(39))
Return thepage
Catch e As Exception
Return False
End Try
End Function