Internal Server Error 500 when calling a REST service in VB - json

I'm working with a coworker's code trying to recreate his REST web service in a console application. I'm very new to web services and VB so it's been quite difficult for me. It will work fine on his but I keep getting an Internal Server Error (500). I have looked this up and some suggestions I found were changing "POST" to "GET" but I received "Cannot get content body with this verb-type". I've seen forums about something like this not working from another person's machine. My coworker and I have tried going through it over and over but getting the same results.
This is the Console App
Imports System
Imports System.Collections.Generic
Imports System.IO
Imports System.Linq
Imports System.Net
Imports System.Reflection
Imports System.Text
Imports System.Threading.Tasks
Imports System.Web
Imports System.Web.UI
Imports System.Xml
Module RestConsoleClient
Private req As HttpWebRequest = Nothing
Private res As HttpWebResponse = Nothing
Private responseText As String = ""
Sub Main(args As String())
Dim url As String = ""
Try
If args.Count < 1 OrElse String.IsNullOrEmpty(args(0)) Then
Console.WriteLine("Endpoint Address is required as commandline argument;" _
& vbCrLf & "Copy/Paste one of the endpoint addresses from My.Settings into the Debug commandline arguments section" _
& vbCrLf & vbCrLf & "Press ENTER to start over...")
Console.ReadKey()
Return
Else
url = args(0)
End If
req = CType(WebRequest.Create(url), HttpWebRequest)
req.Method = "POST"
'** The conditions below allowed for generic raw data to be input as text vs. processing input data as a json object.
'** These conditions became redundant with the addition of config for WebContentTypeMapper and corresponding class to accept
'** a post declared with application/json ContentType as generic raw data, and then SUBSEQUENTLY de/serialize the json data as necessary
'If url.Contains("streamweaver") Then
' req.ContentType = "text"
'ElseIf url.Contains("auth") Then
' req.ContentType = "application/json" '; charset=utf-8"
'Else
' 'No other options are yet determined
'End If
req.Timeout = 30000
Dim sJson As String = "{""Name"":""Ashu"",""Age"":""29"",""Exp"":""7 Years"",""Technology"":"".NET""}"
Dim postBytes = Encoding.UTF8.GetBytes(sJson)
req.ContentLength = postBytes.Length
Dim requestStream As Stream = req.GetRequestStream()
requestStream.Write(postBytes, 0, postBytes.Length)
res = CType(req.GetResponse(), HttpWebResponse)
' I retained the basics for response reception even though it was not integral to this test
Dim responseStream As Stream = res.GetResponseStream()
Dim streamReader = New StreamReader(responseStream)
responseText = streamReader.ReadToEnd()
Console.WriteLine("HTTP Response: " & res.StatusCode & " - " & res.StatusDescription.Trim)
Console.WriteLine("[ Response Data: " & responseText.Trim & " ]")
Console.ReadKey()
Catch ex As Exception
Console.WriteLine(ex.Message)
Console.ReadKey()
End Try
End Sub
End Module
This here is the Interface
Imports System.IO
Imports System.ServiceModel
Imports System.ServiceModel.Web
<ServiceContract> _
Public Interface IRestServiceImpl
'<OperationContract> _
'<WebInvoke(Method:="GET", ResponseFormat:=WebMessageFormat.Xml, BodyStyle:=WebMessageBodyStyle.Wrapped, UriTemplate:="xml/{id}")> _
'Function XMLData(id As String) As String
'<OperationContract> _
'<WebInvoke(Method:="GET", ResponseFormat:=WebMessageFormat.Json, BodyStyle:=WebMessageBodyStyle.Wrapped, UriTemplate:="json/{id}")> _
'Function JSONData(id As String) As String
<OperationContract> _
<WebInvoke(Method:="POST", ResponseFormat:=WebMessageFormat.Json, RequestFormat:=WebMessageFormat.Json, BodyStyle:=WebMessageBodyStyle.Bare, UriTemplate:="auth")> _
Function Auth(rData As Stream) As ResponseData
<OperationContract> _
<WebInvoke(Method:="POST", ResponseFormat:=WebMessageFormat.Json, RequestFormat:=WebMessageFormat.Json, BodyStyle:=WebMessageBodyStyle.Bare, UriTemplate:="streamweaver")> _
Function StreamWeaver(sData As Stream) As String
End Interface
And here is the class
Imports System
Imports System.IO
Imports System.Reflection
Imports System.Security.AccessControl
Imports System.Text
Imports Newtonsoft.Json
Public Class RestServiceImpl
Implements IRestServiceImpl
Private filePathOnServer As String = My.Settings.OutputFolder
'Public Function XMLData(id As String) As String Implements IRestServiceImpl.XMLData
' Return "You requested product " & id
'End Function
'Public Function JSONData(id As String) As String Implements IRestServiceImpl.JSONData
' Return "You requested product " & id
'End Function
Public Function Auth(request As Stream) As ResponseData Implements IRestServiceImpl.Auth
Dim streamReader = New StreamReader(request)
Dim requestText As String = streamReader.ReadToEnd()
Dim rData As RequestData = JsonConvert.DeserializeObject(Of RequestData)(requestText)
Dim response = New ResponseData() With { _
.Name = rData.Name, _
.Age = rData.Age, _
.Exp = rData.Exp, _
.Technology = rData.Technology _
}
Dim fileOutput As String = "As of " & DateTime.Now & ", " _
& response.Name.Trim & " is a person who is " _
& response.Age.Trim & " years old, having " _
& response.Exp.Trim & " of experience with " _
& response.Technology.Trim & " technology."
Console.SetError(New StreamWriter("C:\Users\apearson\Documents\Eureka.txt"))
Console.[Error].WriteLine(fileOutput)
Console.[Error].Close()
Dim ctx As WebOperationContext = WebOperationContext.Current
If rData IsNot Nothing Then
ctx.OutgoingResponse.StatusCode = Net.HttpStatusCode.Accepted
Else
ctx.OutgoingResponse.StatusCode = Net.HttpStatusCode.NotAcceptable
End If
Return response
End Function
Public Function StreamWeaver(reqData As Stream) As String Implements IRestServiceImpl.StreamWeaver
StreamWeaver = Nothing
Dim ctx As WebOperationContext = WebOperationContext.Current
If reqData IsNot Nothing Then
ctx.OutgoingResponse.StatusCode = Net.HttpStatusCode.Accepted
Else
ctx.OutgoingResponse.StatusCode = Net.HttpStatusCode.NotAcceptable
End If
Dim streamReader As StreamReader = New StreamReader(reqData)
StreamWeaver = streamReader.ReadToEnd()
Console.SetError(New StreamWriter(filePathOnServer.Trim & "\RestServiceJSONRaw.txt"))
Console.[Error].WriteLine(DateTime.Now & ": " & vbCrLf & StreamWeaver.Trim)
Console.[Error].Close()
Return StreamWeaver
End Function
End Class
If there is anymore information needed, let me know. Again, this is kind of new to me.

Related

Get properties from Array in JSON in VB.NET

I need result from this JSON:
{
"access_token": "eyJhbGciOiJSUzI1NiIsImtpZCI6IjBGOTkyNkZFQTUyOTgxRjZDMjBENUMzNUQ0NjUxMzAzQ0QzQzBFMzIiLCJ0eXAiOiJhdCtqd 3QiLCJ4NXQiOiJENWttX3FVcGdmYkNEVncxMUdVVEE4MDhEakkifQ.eyJuYmYiOjE2MjA3NzEyNDEsImV4cCI6MTYyMDc3NDg0MSwiaXNzIjoiaH R0cHM6Ly9pZC5wcmVwcm9kLmV0YS5nb3YuZWciLCJhdWQiOiJJbnZvaWNpbmdBUEkiLCJjbGllbnRfaWQiOiJlZWQ4YWY2MS01ZjRmLTQxM2MtYWZlN S1jYjg0YjBiOTlhOGMiLCJJbnRlcm1lZElkIjoiMCIsIkludGVybWVkUklOIjoiIiwiSW50ZXJtZWRFbmZvcmNlZCI6IjIiLCJuYW1lIjoiMjAyNDY5NzM 1OmVlZDhhZjYxLTVmNGYtNDEzYy1hZmU1LWNiODRiMGI5OWE4YyIsInNpZCI6IjJiYzcxYTlhLWQ1MzAtMzc1ZC0zNjMzLTUwN2E3OWFjY2Y1ZiIsInByZW ZlcnJlZF91c2VybmFtZSI6IkVSUCIsIlRheElkIjoiNTE4MDEiLCJUYXhSaW4iOiIyMDI0Njk3MzUiLCJQcm9mSWQiOiI1NDgxNCIsIklzVGF4QWRtaW4iO
iIwIiwiSXNTeXN0ZW0iOiIxIiwiTmF0SWQiOiIiLCJzY29wZSI6WyJJbnZvaWNpbmdBUEkiXX0.IIxTKWdH0cUInlzrIMON95f7S6vW-CBfRoK8ZxOI6mqp
DbRLBaZQZyNoYl4A6JYQR6FJY4YVIFUsAbkKEKwwB1MaOpMMWmkyySfUmgvBMvEo6EZnT-oewnSd2EPF_bIK7-HTGug7Rjdy__wTpBr-6PH5kzR79xXzNh_s
R7TIPcvjJ-nx7eNZREdk4J7M3X8Mfjzww2RkbizN5zXNpmc5OHh_VLtlkA-4zQrs102HA9VFTxLEIdXhrpBqEBmy9dt-onZpuiKbkioV5iH2uwAkQbDvnM9h
p7EJscL0y0xFjfwbAUxQx3ohcXtA31fwyYazKQVKHCtNm9SPgSsQ-rKevQ",
"expires_in": 3600,
"scope": "Accecc DB"
}
I used:
Dim Mytoken As JObject = JObject.Parse(TextBox1.Text)
TextBox2.Text = Mytoken.SelectToken("access_token").ToString
Now I Need to get the uuid, longId, internalId, and hashKey from the acceptedDocuments like this:
{
"submissionId": "5hfhfgy5653uytyu45fg457",
"acceptedDocuments": [
{
"uuid": "hlg5fdg7ggnjgh",
"longId": "jgjhk78jm,jhk54567ujnfgh7fggh",
"internalId": "477",
"hashKey": "dfgdfhdyjfghryjghjj"
}
],
"rejectedDocuments": []
}
You could use Newtonsoft.Json and deserialize the response into an object:
Imports Newtonsoft.Json
Public Class Submission
Public submissionId As String
Public acceptedDocuments As List(Of AcceptedDocuments)
Public rejectedDocuements As String 'not sure of the type of this property
End Class
Public Class AcceptedDocuments
Public uuid As String
Public longId As String
Public internalId As Integer
Public hashKey As String
End Class
Public Function DeserilizeJson(ByRef json As String) As Submission
Dim doc As Submission = JsonConvert.DeserializeObject(Of Submission)(json)
Return doc
End Function
This should result in a Submission class object being created, to which you can reference all of the members of it, including the List of AcceptedDocuments (you can iterate over the list as needed).
I solved the problem
Dim Mytoken As JObject = JObject.Parse(TextBox1.Text)
TextBox2.Text = "My submissionId IS: " & Mytoken.SelectToken("submissionId").ToString & Environment.NewLine & Environment.NewLine
Dim arrray As JArray = JArray.Parse(Mytoken.SelectToken("acceptedDocuments").ToString)
For Each acceptedDocuments In arrray
TextBox2.Text = TextBox2.Text & "My uuid IS: " & acceptedDocuments.SelectToken("uuid").ToString & Environment.NewLine
TextBox2.Text = TextBox2.Text & "My longId IS: " & acceptedDocuments.SelectToken("longId").ToString & Environment.NewLine
TextBox2.Text = TextBox2.Text & "My internalId IS: " & acceptedDocuments.SelectToken("internalId").ToString & Environment.NewLine
TextBox2.Text = TextBox2.Text & "My hashKey IS: " & acceptedDocuments.SelectToken("hashKey").ToString & Environment.NewLine
Next

How to read and process multiple JSON API responses asynchronously?

I'm reading JSON responses from the Binance Api, from this link
I need to get some of the data out of it and this is the code I'm using:
Imports System.Net
Imports Newtonsoft.Json
Imports System.Collections.Generic
Public Class Form1
Private wc As New WebClient()
Private wc1 As New WebClient()
Private wc2 As New WebClient()
Private Async Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
Dim btc = Await wc.DownloadStringTaskAsync("https://api.binance.com/api/v1/ticker/24hr?symbol=BTCEUR")
Dim doge = Await wc1.DownloadStringTaskAsync("https://api.binance.com/api/v1/ticker/24hr?symbol=DOGEEUR")
Dim bnb = Await wc2.DownloadStringTaskAsync("https://api.binance.com/api/v1/ticker/24hr?symbol=BNBEUR")
Dim d = JsonConvert.DeserializeObject(Of Dictionary(Of String, String))(btc)
Dim d1 = JsonConvert.DeserializeObject(Of Dictionary(Of String, String))(doge)
Dim d2 = JsonConvert.DeserializeObject(Of Dictionary(Of String, String))(bnb)
Label1.Text = "PRICE " + d("lastPrice")
Label2.Text = "24H CHANGE " + d("priceChange")
Label3.Text = "24H CHANGE % " + d("priceChangePercent")
Label4.Text = "HIGH 24H " + d("highPrice")
Label5.Text = "LOW 24H " + d("lowPrice")
Label6.Text = "PRICE " + d1("lastPrice")
Label7.Text = "24H CHANGE " + d1("priceChange")
Label8.Text = "24H CHANGE % " + d1("priceChangePercent")
Label9.Text = "HIGH 24H " + d1("highPrice")
Label10.Text = "LOW 24H " + d1("lowPrice")
Label11.Text = "PRICE " + d2("lastPrice")
Label12.Text = "24H CHANGE " + d2("priceChange")
Label13.Text = "24H CHANGE % " + d2("priceChangePercent")
Label14.Text = "HIGH 24H " + d2("highPrice")
Label15.Text = "LOW 24H " + d2("lowPrice")
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Timer1.Start()
End Sub
End Class
This code is working perfectly, the Timer.Intrval is set at 1000ms, but after a while I'm getting an exception:
System.NotSupportedException: WebClient does not support concurrent I/O operations
in the line:
Dim bnb = Await wc2.DownloadStringTaskAsync("https://api.binance.com/api/v1/ticker/24hr?symbol=BNBEUR")
How can I solve it? It doesn't seems wrong cause I'm using 3 different WebClients objects to do that.
Also, how can I just display just 2 decimals after the comma ?
Since you have all async method to call, I suggest to move the API requests to an async method that, when initialized, keeps sending requests to the API - with a delay between calls - until the CancellationToken passed to the method signals that its time to quit.
I'm passing a Progress<T> delegate to the method, which is responsible to update the UI when the Tasks started by the aysnc method return their results.
The delegate of course executes in the UI Thread (here; anyway, the Thread that created and initialized it).
You can run this method from any other method / event handler that can be aysnc. Here, for example, the Click handler of a button. You can also start it from the Form.Load handler. Or whatever else.
I've decide to deserialize the JSON responses to a class model, since some values need to be converted to different types to make sense. As the Date/Time values returned, which are expressed in Unix (milliseconds) notation. So I'm using a custom UnixDateTimeConverter to convert the Date/Time values to DateTimeOffset structures.
Imports System.Net
Imports System.Net.Http
Imports System.Threading
Imports System.Threading.Tasks
Imports Newtonsoft.Json
Imports Newtonsoft.Json.Converters
Private ctsBinance As CancellationTokenSource = Nothing
Private Async Sub SomeButton_Click(sender As Object, e As EventArgs) Handles SomeButton.Click
ctsBinance = New CancellationTokenSource()
Dim progressReport = New Progress(Of BinanceResponseRoot())(AddressOf BinanceProgress)
Try
' Pass the Pogress<T> delegate, the delay in ms and the CancellationToken
Await DownLoadBinanceData(progressReport, 1000, ctsBinance.Token)
Catch tcEx As TaskCanceledException
Console.WriteLine("Tasks canceled")
Finally
ctsBinance.Dispose()
End Try
End Sub
Private Sub BinanceProgress(results As BinanceResponseRoot())
Console.WriteLine("PRICE " & results(0).LastPrice.ToString("N2"))
Console.WriteLine("24H CHANGE " & results(0).PriceChange.ToString("N2"))
Console.WriteLine("24H CHANGE % " & results(0).PriceChangePercent.ToString("N2"))
Console.WriteLine("HIGH 24H " & results(0).HighPrice.ToString("N2"))
Console.WriteLine("LOW 24H " & results(0).LowPrice.ToString("N2"))
Console.WriteLine("PRICE " & results(1).LastPrice.ToString("N2"))
Console.WriteLine("24H CHANGE " & results(1).PriceChange.ToString("N2"))
Console.WriteLine("24H CHANGE % " & results(1).PriceChangePercent.ToString("N2"))
Console.WriteLine("HIGH 24H " & results(1).HighPrice.ToString("N2"))
Console.WriteLine("LOW 24H " & results(1).LowPrice.ToString("N2"))
Console.WriteLine("PRICE " & results(1).LastPrice.ToString("N2"))
Console.WriteLine("24H CHANGE " & results(2).PriceChange.ToString("N2"))
Console.WriteLine("24H CHANGE % " & results(2).PriceChangePercent.ToString("N2"))
Console.WriteLine("HIGH 24H " & results(2).HighPrice.ToString("N2"))
Console.WriteLine("LOW 24H " & results(2).LowPrice.ToString("N2"))
End Sub
To cancel the execution of the Tasks, call the Cancel() method of the CancellationTokenSource. If the Tasks are not canceled before the Form / Window closes, call it when the Form / Window is closing, handling that event.
ctsBinance?.Cancel()
ctsBinance = Nothing
The worker method:
The method keeps running queries to the API in parallel until a cancellation is requested, calling the Cancel() method of the CancellationTokenSource.
I'm using a static HttpClient to send the API requests, since this is more likely its kind of job (no custom initialization, it uses all defaults: you may need to initialize a HttpClientHandler in some contexts, as specific Security Protocols).
All HttpClient.GetAsStringAsync() Tasks are added to a List(Of Task), then all Tasks are executed calling Task.WhenAll().
When all Tasks return, the API responses are deserialized to the BinanceResponseRoot model and the Progress<T> delegate is called to update the UI with the information received.
Private Shared binanceClient As New HttpClient()
Public Async Function DownLoadBinanceData(progress As IProgress(Of BinanceResponseRoot()),
delay As Integer, token As CancellationToken) As Task
While Not token.IsCancellationRequested
Dim tasks As New List(Of Task(Of String))({
binanceClient.GetStringAsync("https://api.binance.com/api/v1/ticker/24hr?symbol=BTCEUR"),
binanceClient.GetStringAsync("https://api.binance.com/api/v1/ticker/24hr?symbol=DOGEEUR"),
binanceClient.GetStringAsync("https://api.binance.com/api/v1/ticker/24hr?symbol=BNBEUR")
})
Await Task.WhenAll(tasks)
Dim btcEur = JsonConvert.DeserializeObject(Of BinanceResponseRoot)(tasks(0).Result)
Dim dogeEur = JsonConvert.DeserializeObject(Of BinanceResponseRoot)(tasks(1).Result)
Dim bnbEur = JsonConvert.DeserializeObject(Of BinanceResponseRoot)(tasks(2).Result)
progress.Report({btcEur, dogeEur, bnbEur})
Await Task.Delay(delay, token)
End While
End Function
Class Model to convert that JSON data to the corresponding .Net Type values:
Public Class BinanceResponseRoot
Public Property Symbol As String
Public Property PriceChange As Decimal
Public Property PriceChangePercent As Decimal
Public Property WeightedAvgPrice As Decimal
Public Property PrevClosePrice As Decimal
Public Property LastPrice As Decimal
Public Property LastQty As Decimal
Public Property BidPrice As Decimal
Public Property BidQty As Decimal
Public Property AskPrice As Decimal
Public Property AskQty As Decimal
Public Property OpenPrice As Decimal
Public Property HighPrice As Decimal
Public Property LowPrice As Decimal
Public Property Volume As Decimal
Public Property QuoteVolume As Decimal
<JsonConverter(GetType(BinanceDateConverter))>
Public Property OpenTime As DateTimeOffset
<JsonConverter(GetType(BinanceDateConverter))>
Public Property CloseTime As DateTimeOffset
Public Property FirstId As Long
Public Property LastId As Long
Public Property Count As Long
End Class
Friend Class BinanceDateConverter
Inherits UnixDateTimeConverter
Public Overrides Function CanConvert(t As Type) As Boolean
Return t = GetType(Long) OrElse t = GetType(Long?)
End Function
Public Overrides Function ReadJson(reader As JsonReader, t As Type, existingValue As Object, serializer As JsonSerializer) As Object
Dim uxDT As Long? = serializer.Deserialize(Of Long?)(reader)
Return DateTimeOffset.FromUnixTimeMilliseconds(uxDT.Value)
End Function
Public Overrides Sub WriteJson(writer As JsonWriter, value As Object, serializer As JsonSerializer)
Dim dtmo = DirectCast(value, DateTimeOffset)
If dtmo <> DateTimeOffset.MinValue Then
serializer.Serialize(writer, CType(DirectCast(value, DateTimeOffset).ToUnixTimeMilliseconds(), ULong))
Else
MyBase.WriteJson(writer, Nothing, serializer)
End If
End Sub
End Class
1000ms is probably too fast, the wc2.DownloadStringTaskAsync task is probably not finished. You can Stop your timer before starting those download tasks and Start it again when the tasks are done:
Private Async Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
Timer1.Stop
Dim downloadTasks As New List(Of Task(Of String))
Dim btc = wc.DownloadStringTaskAsync("https://api.binance.com/api/v1/ticker/24hr?symbol=BTCEUR")
Dim doge = wc1.DownloadStringTaskAsync("https://api.binance.com/api/v1/ticker/24hr?symbol=DOGEEUR")
Dim bnb = wc2.DownloadStringTaskAsync("https://api.binance.com/api/v1/ticker/24hr?symbol=BNBEUR")
downloadTasks.Add(btc)
downloadTasks.Add(doge)
downloadTasks.Add(bnb)
Await Task.WhenAll(downloadTasks)
Dim d = JsonConvert.DeserializeObject(Of Dictionary(Of String, String))(btc.Result)
Dim d1 = JsonConvert.DeserializeObject(Of Dictionary(Of String, String))(doge.Result)
Dim d2 = JsonConvert.DeserializeObject(Of Dictionary(Of String, String))(bnb.Result)
Label1.Text = "PRICE " + d("lastPrice")
Label2.Text = "24H CHANGE " + d("priceChange")
Label3.Text = "24H CHANGE % " + d("priceChangePercent")
Label4.Text = "HIGH 24H " + d("highPrice")
Label5.Text = "LOW 24H " + d("lowPrice")
Label6.Text = "PRICE " + d1("lastPrice")
Label7.Text = "24H CHANGE " + d1("priceChange")
Label8.Text = "24H CHANGE % " + d1("priceChangePercent")
Label9.Text = "HIGH 24H " + d1("highPrice")
Label10.Text = "LOW 24H " + d1("lowPrice")
Label11.Text = "PRICE " + d2("lastPrice")
Label12.Text = "24H CHANGE " + d2("priceChange")
Label13.Text = "24H CHANGE % " + d2("priceChangePercent")
Label14.Text = "HIGH 24H " + d2("highPrice")
Label15.Text = "LOW 24H " + d2("lowPrice")
Timer1.Start
End Sub
That way you will be sure the previous download has completed.
You can also check if the WebClient is still busy using the WebClient.IsBusy property before starting another download.
As far as displaying 2 decimals, take a look at Strings.FormatNumber. You can specify a NumDigitsAfterDecimal parameter that indicates
how many places are displayed to the right of the decimal. The default value is -1, which indicates that the computer's regional settings are used.

Error sending JSON object as a POST request [VB.NET]

I am trying to send JSON object from VB.NET app (3.5 Framework).
I am using this code:
Private Function sendSMS()
Dim objHTTP As Object
Dim json As String
Dim result As String
Dim URL As String
json = fJSON()
objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
URL = "https://api.XXXXXXXXX.com/api/3.0/sms/send"
objHTTP.Open("POST", URL, False)
objHTTP.setRequestHeader("Content-type", "application/json")
objHTTP.send(json)
result = objHTTP.responseText
objHTTP = Nothing
End Function
Private Function fJSON() As String
fJSON = "{"
fJSON = fJSON & """api_key"":""XXXXXXXXXXXXXXXXXXX"","
fJSON = fJSON & """concat"":1,"
fJSON = fJSON & """fake"":1,"
fJSON = fJSON & """messages"":["
fJSON = fJSON & "{"
fJSON = fJSON & """from"":""SHOP"","
fJSON = fJSON & """to"":""3400000000"","
fJSON = fJSON & """text"":""LOREM IPSUM"""
fJSON = fJSON & "}]}"
End Function
But I am getting this error in the line code:
Line code:
objHTTP.setRequestHeader("Content-type", "application/json")
Error:
System.Runtime.InteropServices.COMException (0x80004005): Error no especificado
What is wrong?
Sometimes user doesn't have enough privileges to run some COM Methods. Here your exception says "System.Runtime.InteropServices.COMException (0x80004005)" which is based on System.Runtime.InteropServices.COMException. To sort it out, Will you ran Visual Studio as Administrator and check wheather that logic works for you or not?

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

Show File Path in Access 2010 Form

I have a form in Access 2010 that allows the user to find an Excel file and map it so that it can easily be accessed from another form. The simplest way to explain it, I think, is with a picture:
The form has this On Load event:
Private Sub Form_Load()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim sSQL As String
Dim sPath As String
Set db = CurrentDb
On Error GoTo Error_Handler
sPath = Application.CurrentProject.Path
sSQL = "Select Setting from tblBackendFiles where Code = 'SourceVerification'"
Set rs = db.OpenRecordset(sSQL)
Me.tVerificationPath = Nz(rs!Setting, "")
If Len(Me.tVerificationPath) = 0 Then
Me.tExcelPath = sPath
End If
Me.cmdAcceptPath.SetFocus
rs.Close
GoTo exit_sub
Error_Handler:
MsgBox Err.number & ": " & Err.Description, vbInformation + vbOKOnly, "Error!"
exit_sub:
Set rs = Nothing
Set db = Nothing
End Sub
What I want is to have the current path of the Excel file displayed in the textbox, which is currently unbound. I've looked around online but I'm having a hard time finding how to actually get the path to show up.
What would be the best way to do this? I'd prefer to do it without VBA if at all possible, but I'm not 100% opposed to it.
I have done this many times. You will have to create a form. On that form, place a textbox called "tbFile", another called "tbFileName" (which is invisible) and a button called "bBrowse".
Then, behind your form, put this:
Option Compare Database
Option Explicit
Private Sub bBrowse_Click()
On Error GoTo Err_bBrowse_Click
Dim strFilter As String
Dim lngFlags As Long
Dim varFileName As Variant
Me.tbHidden.SetFocus
' strFilter = "Access (*.mdb)" & vbNullChar & "*.mdb" _
' & vbNullChar & "All Files (*.*)" & vbNullChar & "*.*"
' strFilter = "Access Files (*.mdb)" & vbNullChar & "*.mdb*"
strFilter = "All Files (*.*)" & vbNullChar & "*.*"
lngFlags = tscFNPathMustExist Or tscFNFileMustExist Or tscFNHideReadOnly
varFileName = tsGetFileFromUser( _
fOpenFile:=True, _
strFilter:=strFilter, _
rlngflags:=lngFlags, _
strInitialDir:="C:\Windows\", _
strDialogTitle:="Find File (Select The File And Click The Open Button)")
'remove the strInitialDir:="C:\Windows\", _ line if you do not want the Browser to open at a specific location
If IsNull(varFileName) Or varFileName = "" Then
Debug.Print "User pressed 'Cancel'."
Beep
MsgBox "File selection was canceled.", vbInformation
Exit Sub
Else
'Debug.Print varFileName
tbFile = varFileName
End If
Call ParseFileName
Exit_bBrowse_Click:
Exit Sub
Err_bBrowse_Click:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_bBrowse_Click
End Sub
Private Function ParseFileName()
On Error GoTo Err_ParseFileName
Dim sFullName As String
Dim sFilePathOnly As String
Dim sDrive As String
Dim sPath As String
Dim sLocation As String
Dim sFileName As String
sFullName = tbFile.Value
' Find the final "\" in the path.
sPath = sFullName
Do While Right$(sPath, 1) <> "\"
sPath = Left$(sPath, Len(sPath) - 1)
Loop
' Find the Drive.
sDrive = Left$(sFullName, InStr(sFullName, ":") + 1)
'tbDrive = sDrive
' Find the Location.
sLocation = Mid$(sPath, Len(sDrive) - 2)
'tbLocation = sLocation
' Find the Path.
sPath = Mid$(sPath, Len(sDrive) + 1)
'tbPath = sPath
' Find the file name.
sFileName = Mid$(sFullName, Len(sPath) + 4)
tbFileName = sFileName
Exit_ParseFileName:
Exit Function
Err_ParseFileName:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_ParseFileName
End Function
Then, create a new Module and paste this into it:
Option Compare Database
Option Explicit
Private Declare Function ts_apiGetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (tsFN As tsFileName) As Boolean
Private Declare Function ts_apiGetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (tsFN As tsFileName) As Boolean
Private Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
Private Type tsFileName
lStructSize As Long
hwndOwner As Long
hInstance As Long
strFilter As String
strCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
strFile As String
nMaxFile As Long
strFileTitle As String
nMaxFileTitle As Long
strInitialDir As String
strTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
strDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
' Flag Constants
Public Const tscFNAllowMultiSelect = &H200
Public Const tscFNCreatePrompt = &H2000
Public Const tscFNExplorer = &H80000
Public Const tscFNExtensionDifferent = &H400
Public Const tscFNFileMustExist = &H1000
Public Const tscFNPathMustExist = &H800
Public Const tscFNNoValidate = &H100
Public Const tscFNHelpButton = &H10
Public Const tscFNHideReadOnly = &H4
Public Const tscFNLongNames = &H200000
Public Const tscFNNoLongNames = &H40000
Public Const tscFNNoChangeDir = &H8
Public Const tscFNReadOnly = &H1
Public Const tscFNOverwritePrompt = &H2
Public Const tscFNShareAware = &H4000
Public Const tscFNNoReadOnlyReturn = &H8000
Public Const tscFNNoDereferenceLinks = &H100000
Public Function tsGetFileFromUser( _
Optional ByRef rlngflags As Long = 0&, _
Optional ByVal strInitialDir As String = "", _
Optional ByVal strFilter As String = "All Files (*.*)" & vbNullChar & "*.*", _
Optional ByVal lngFilterIndex As Long = 1, _
Optional ByVal strDefaultExt As String = "", _
Optional ByVal strFileName As String = "", _
Optional ByVal strDialogTitle As String = "", _
Optional ByVal fOpenFile As Boolean = True) As Variant
On Error GoTo tsGetFileFromUser_Err
Dim tsFN As tsFileName
Dim strFileTitle As String
Dim fResult As Boolean
' Allocate string space for the returned strings.
strFileName = Left(strFileName & String(256, 0), 256)
strFileTitle = String(256, 0)
' Set up the data structure before you call the function
With tsFN
.lStructSize = Len(tsFN)
.hwndOwner = Application.hWndAccessApp
.strFilter = strFilter
.nFilterIndex = lngFilterIndex
.strFile = strFileName
.nMaxFile = Len(strFileName)
.strFileTitle = strFileTitle
.nMaxFileTitle = Len(strFileTitle)
.strTitle = strDialogTitle
.flags = rlngflags
.strDefExt = strDefaultExt
.strInitialDir = strInitialDir
.hInstance = 0
.strCustomFilter = String(255, 0)
.nMaxCustFilter = 255
.lpfnHook = 0
End With
' Call the function in the windows API
If fOpenFile Then
fResult = ts_apiGetOpenFileName(tsFN)
Else
fResult = ts_apiGetSaveFileName(tsFN)
End If
' If the function call was successful, return the FileName chosen
' by the user. Otherwise return null. Note, the CancelError property
' used by the ActiveX Common Dialog control is not needed. If the
' user presses Cancel, this function will return Null.
If fResult Then
rlngflags = tsFN.flags
tsGetFileFromUser = tsTrimNull(tsFN.strFile)
Else
tsGetFileFromUser = Null
End If
tsGetFileFromUser_End:
On Error GoTo 0
Exit Function
tsGetFileFromUser_Err:
Beep
MsgBox Err.Description, , "Error: " & Err.Number _
& " in function basBrowseFiles.tsGetFileFromUser"
Resume tsGetFileFromUser_End
End Function
' Trim Nulls from a string returned by an API call.
Private Function tsTrimNull(ByVal strItem As String) As String
On Error GoTo tsTrimNull_Err
Dim I As Integer
I = InStr(strItem, vbNullChar)
If I > 0 Then
tsTrimNull = Left(strItem, I - 1)
Else
tsTrimNull = strItem
End If
tsTrimNull_End:
On Error GoTo 0
Exit Function
tsTrimNull_Err:
Beep
MsgBox Err.Description, , "Error: " & Err.Number _
& " in function basBrowseFiles.tsTrimNull"
Resume tsTrimNull_End
End Function
Public Sub tsGetFileFromUserTest()
On Error GoTo tsGetFileFromUserTest_Err
Dim strFilter As String
Dim lngFlags As Long
Dim varFileName As Variant
' strFilter = "Access (*.mdb)" & vbNullChar & "*.mdb" _
' & vbNullChar & "All Files (*.*)" & vbNullChar & "*.*"
strFilter = "All Files (*.*)" & vbNullChar & "*.*"
lngFlags = tscFNPathMustExist Or tscFNFileMustExist Or tscFNHideReadOnly
varFileName = tsGetFileFromUser( _
fOpenFile:=True, _
strFilter:=strFilter, _
rlngflags:=lngFlags, _
strDialogTitle:="GetFileFromUser Test (Please choose a file)")
If IsNull(varFileName) Then
Debug.Print "User pressed 'Cancel'."
Else
Debug.Print varFileName
'Forms![Form1]![Text1] = varFileName
End If
If varFileName <> "" Then MsgBox "You selected the '" & varFileName & "' file.", vbInformation
tsGetFileFromUserTest_End:
On Error GoTo 0
Exit Sub
tsGetFileFromUserTest_Err:
Beep
MsgBox Err.Description, , "Error: " & Err.Number _
& " in sub basBrowseFiles.tsGetFileFromUserTest"
Resume tsGetFileFromUserTest_End
End Sub
VOILA! Easy as that. ;o)