How to execute a webrequest asynchronous to parse json - vb.net

I need to get a value from an API and I'm using the follow code synchronous.
Dim request As HttpWebRequest
Dim response As HttpWebResponse = Nothing
Dim reader As StreamReader
Try
request = DirectCast(WebRequest.Create("http://ecc"), HttpWebRequest)
response = DirectCast(request.GetResponse(), HttpWebResponse)
reader = New StreamReader(response.GetResponseStream())
Dim rawresp As String
rawresp = reader.ReadToEnd()
Dim jResults As JObject = JObject.Parse(rawresp)
Label1.Text = jResults("result").ToString()
Catch ex As Exception
MsgBox(ex.ToString)
Finally
If Not response Is Nothing Then response.Close()
End Try
The problem is that's synchronous, I want to make it async in order not to freeze the form in the while.
How can I async it?

You can easily use WebClient and the nuget package NewtonSoft doing something like this:
Imports System.IO
Imports System.Net
Imports System.Text
Imports Newtonsoft.Json
Public Class Form1
Private ReadOnly wc As New WebClient()
Private Async Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
'stop timer to avoid simultaneous I/O operations
Timer1.Stop()
Dim downloadTasks As New List(Of Task(Of String))
'download api and add as a task of string
Dim APIValue = wc.DownloadStringTaskAsync("https://api.etc")
downloadTasks.Add(Value)
Await Task.WhenAll(downloadTasks)
Dim d = JsonConvert.DeserializeObject(Of Dictionary(Of String, String))(APIValue.Result)
Dim Price As String = d("result").ToString
Label1.Text = Price
Timer1.Start()
End Sub
End Class

Much simpler with HttpClient and JsonNode:
'// Web API:
'// app.MapGet("/api", () => new { id = 1, result = "100", name = "name1" });
Imports System.Net.Http
Imports System.Text.Json.Nodes
Using http = New HttpClient
Dim url = "https://localhost:5000/api"
Dim json = JsonNode.Parse(Await http.GetStreamAsync(url))
Label1.Text = json("result")
End Using

Related

Problem with Crunch occurring after some time FtpWebRequest in vb.net

i have this Code From My Class
The code is working fine, but the memory is increasing, which is causing Crunch to close the program for itself
I tried all the methods and did not find a solution to this problem
Imports System.Net
Imports System.IO
Public Class class1
Private host As String
Private password As String
Private username As String
Dim x As New List(Of String)
Public Sub New(host As String, username As String, password As String)
Me.host = host
Me.username = username
Me.password = password
End Sub
Friend Sub start()
Try
Dim request As FtpWebRequest = WebRequest.Create("ftp://" + Me.host)
request.Timeout = 4000
request.Credentials = New NetworkCredential(Me.username, Me.password)
request.Method = WebRequestMethods.Ftp.ListDirectory
'-----------------------------------
Try
'-----------------------------------
Dim listResponse As FtpWebResponse = request.GetResponse()
' listResponse = request.GetResponse()
Dim reader As StreamReader = New System.IO.StreamReader(listResponse.GetResponseStream())
Dim Filedata As String = reader.ReadToEnd
'-----------------------------------
x.Add(Filedata)
'-----------------------------------
File.WriteAllLines(IO.Directory.GetCurrentDirectory() & "\logs.txt", x)
'-----------------------------------
Threading.Thread.Sleep(1000)
listResponse.Close()
listResponse.Dispose()
request.Abort()
Catch ex As WebException
request.Abort()
Exit Sub
End Try
Catch ex As Exception
Exit Sub
End Try
Exit Sub
End Sub
End Class
i Call this class from the main app
This method call
And use threading
Dim x As New testing(host, username, password)
x.start()
can anyone help me do this i am using Vb.net

Creating a Microsoft Teams Meeting using VB.NET and Microsoft Graph API

I have created a login authentication using the Microsoft Graph API which means after I sign in, as a result, I have the access token of the current user signed-in. My next step is to create a Microsoft Teams Meeting on behalf of the current user signed-in.
I have tried to follow the Microsoft documentation Application POST onlinemeetings, where It shows the required steps to achieve this scenario.
Unfortunately, they didn't provide an example of how it can be achieved in VB.Net (which is not a big deal because I have converted the code to VB).
Currently, I am stuck on sending a POST request to generate this meeting based on the hard coded values when the user clicks on the button.
Please have a look at the code below:
Imports System.IO
Imports System.Net
Imports System.Net.Http
Imports System.Net.Http.Headers
Imports System.Threading.Tasks
Imports Microsoft.Graph
Imports Microsoft.IdentityModel.Clients.ActiveDirectory
Imports Newtonsoft.Json
Imports Newtonsoft.Json.Linq
Public Class _Default
Inherits Page
Private Shared httpClient As HttpClient = New HttpClient()
Private Shared context As AuthenticationContext = Nothing
Private Shared credential As ClientCredential = Nothing
Private Shared graphClient As GraphServiceClient
Private Shared authprovider As IAuthenticationProvider
Protected Sub Page_Load(ByVal sender As Object, ByVal e As EventArgs) Handles Me.Load
Dim code = HttpContext.Current.Request.QueryString("Code")
If Not Page.IsPostBack Then
If code <> "" Then
Dim url = "https://login.microsoftonline.com/common/oauth2/v2.0/token"
Dim myParameters = "grant_type=authorization_code&code=" & code & "&redirect_uri=https://localhost:4312/&client_id=CLIENTID&client_secret=CLIENTSECRET"
Dim wb = New WebClient
wb.Headers(HttpRequestHeader.ContentType) = "application/x-www-form-urlencoded"
Dim response = wb.UploadString(url, "POST", myParameters)
responseToken.Text = response
Success.Text = "O365 login successful. Below is the response token"
Dim SurroundingClass = JsonConvert.DeserializeObject(Of SurroundingClass)(response)
Dim rss As JObject = JObject.Parse(response)
Dim token = rss.SelectToken("access_token")
Dim res = GetUsers(token)
End If
End If
End Sub
Private Shared Async Function GetUsers(ByVal result As String) As Task(Of String)
Try
Dim users As String = Nothing
Dim querystring As String = "api-version=1.6"
Dim uri = "https://graph.microsoft.com/v1.0/me"
httpClient.DefaultRequestHeaders.Authorization = New AuthenticationHeaderValue("Bearer", result)
httpClient.DefaultRequestHeaders.Accept.Add(New MediaTypeWithQualityHeaderValue("application/json"))
Dim User = GetMeAsync().Result
Console.WriteLine($"Welcome {User.DisplayName}!\n")
Dim getResult = Await httpClient.GetAsync(uri)
If getResult.Content IsNot Nothing Then
users = Await getResult.Content.ReadAsStringAsync()
End If
Return users
Catch ex As Exception
Throw ex
End Try
End Function
Protected Sub tes_Click(sender As Object, e As EventArgs)
Try
'Dim fr As System.Net.HttpWebRequest
Dim client_id = ""// App Client ID'
Dim uri = "https://localhost:4312/"
Dim targetURI As String = "https://login.microsoftonline.com/common/oauth2/v2.0/authorize?client_id=" & client_id &
"&redirect_uri=" & uri & "&response_type=code&scope=openid+Mail.Read"
Response.Redirect(targetURI)
Catch ex As System.Net.WebException
'Error in accessing the resource, handle it
End Try
End Sub
Public Shared Async Function CreateMeeting() As Task(Of OnlineMeeting)
Try
graphClient = New GraphServiceClient(authprovider)
Dim onlineMeeting = New OnlineMeeting With {
.StartDateTime = DateTimeOffset.Parse("2020-04-23T21:33:30.8546353+00:00"),
.EndDateTime = DateTimeOffset.Parse("2020-04-23T22:03:30.8566356+00:00"),
.Subject = "Application Token Meeting",
.Participants = New MeetingParticipants With {
.Organizer = New MeetingParticipantInfo With {
.Identity = New IdentitySet With {
.User = New Identity With {
.Id = "MYID"
}
}
}
}
}
Dim encodings As New UTF8Encoding
Dim serializer As New JavaScriptSerializer()
Dim arrayJson As String = serializer.Serialize(onlineMeeting)
Dim result As String = Nothing
Dim postRequest As HttpWebRequest = DirectCast(WebRequest.Create("https://graph.microsoft.com/v1.0/me/onlineMeetings"), HttpWebRequest)
postRequest.Method = "POST"
postRequest.ContentType = "application/json"
httpClient.DefaultRequestHeaders.Authorization = New AuthenticationHeaderValue("Bearer", Token)
If postRequest.Method = "POST" Then
Dim parsedContent As String = JsonConvert.SerializeObject(onlineMeeting)
Dim encoding As ASCIIEncoding = New ASCIIEncoding()
Dim bytes As Byte() = encoding.GetBytes(parsedContent)
Dim newStream As Stream = postRequest.GetRequestStream()
newStream.Write(bytes, 0, bytes.Length)
newStream.Close()
End If
Dim createMeetings = Await graphClient.Communications.OnlineMeetings.Request().AddAsync(onlineMeeting)
Console.WriteLine("The meeting has been created")
Return createMeetings
Catch ex As ServiceException
Console.WriteLine($"Error while creating the meeting: {ex.Message}")
Return Nothing
End Try
End Function
Public Sub InvokeMeeting(sender As Object, e As EventArgs)
Try
Dim testing = CreateMeeting()
Catch ex As Exception
End Try
End Sub
PS: I have added the permission required to call this API to be able to create a Teams meeting.
Any suggestions on how to achieve the following scenario?
Any help will be greatly appreciated.
Thank you!

What is Equivalent hash_hmac PHP on Visual Basic .Net

I'm rewriting hash_hmac code I got on PHP to VB.Net.
I need same result generated both in PHP and VB.Net.
This is hash_hmac code on PHP:
$data = urlencode('2019-07-21T15:30:57.465Z');
$data = '_ts='.$data;
$signatureSecretKey = "secrete";
$hash = hash_hmac('sha256',$data,$signatureSecretKey,true);
$signature = base64_encode($hash);
echo $signature;
The result shows:
upLQYFI3pI2m9Pu5fyiobpvCRhTvRmEyxrVDrdJOYG4=
And here is my code on VB:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim _ts, data, signature, secrete, hash
secrete = "secret"
_ts = DateTime.Now.ToString("2019-07-21T15:30:57.465Z")
data = "_ts=" & HttpUtility.UrlEncode(_ts)
signature = Encrypt(data, secrete)
TextBox1.Text = signature
End Sub
Public Function Encrypt(Content As String, Secret As String) As String
Dim kode As New System.Text.ASCIIEncoding()
Dim getkode As Byte() = kode.GetBytes(Secret)
Dim cont As Byte() = kode.GetBytes(Content)
Dim hmcKu As New HMACSHA256(getkode)
Dim HashCode As Byte() = hmcKu.ComputeHash(cont)
Return Convert.ToBase64String(HashCode)
End Function
Result of my code is:
892q1ArPxIqrX48PQegliVql703V2fcipb5A08F053o=
You can see my VB code generates different result from PHP.
I have tried almost every method I got from internet but the result always different. So, what is equivalent hash_hmac of PHP on VB and what is the right way to make this same result?
Please help?
Use this:
dim hmac as HMACSHA256 = new HMACSHA256(key) ' key = Encoding.ASCII.GetBytes("<secret>")
dim hashValue as byte() = hmac.ComputeHash(Encoding.ASCII.GetBytes("<message>"))
dim result as string = BitConverter.ToString(hashValue).Replace("-", "").ToLower()
hmac.dispose()
I found solution from fb community.
This is exact solution for this cases:
Imports System.IO
Imports System.Text
Imports System.Security.Cryptography
Imports System.Text.RegularExpressions
Public Class Form1
Private Shared DES As New TripleDESCryptoServiceProvider
Private Shared MD5 As New MD5CryptoServiceProvider
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim _ts, data, signature, secrete
secrete = "secret"
_ts = DateTime.Now.ToUniversalTime.ToString("yyyy-MM-dd\THH:mm:ss.fff\Z")
data = "_ts=" & HttpUtility.UrlEncode(_ts)
Dim reg = New Regex("%[a-f0-9]{2}")
data = reg.Replace(data, Function(m) m.Value.ToUpperInvariant())
signature = Encrypt(data, secrete)
TextBox1.Text = signature
End Sub
Public Function Encrypt(Content As String, Secret As String) As String
Try
Dim kode As New System.Text.ASCIIEncoding()
Dim getkode As Byte() = kode.GetBytes(Secret)
Dim cont As Byte() = kode.GetBytes(Content)
Dim hmcKu As New HMACSHA256(getkode)
Dim HashCode As Byte() = hmcKu.ComputeHash(cont)
Return Convert.ToBase64String(HashCode)
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Function
End Class

Insert string to <input> tag

I'm developing a client that connects to my server, and get access to download and upload files, and i seem to be stuck at uploading files. Here is my code on my VB.NET client:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click 'Upload button
WebBrowser1.Visible = True
'Style OpenFileDialog1
OpenFileDialog1.Title = "Select file to upload"
OpenFileDialog1.InitialDirectory = System.Environment.SpecialFolder.Desktop
OpenFileDialog1.ShowDialog()
End Sub
Private Sub OpenFileDialog1_FileOk(sender As Object, e As System.ComponentModel.CancelEventArgs) Handles OpenFileDialog1.FileOk
uploadFile = OpenFileDialog1.FileName.ToString()
If uploadFile = Nothing Then
MessageBox.Show("You just selected nothing.", "Information")
Else
WebBrowser1.Document.GetElementById("fileselect").SetAttribute("value", uploadFile)
WebBrowser1.Document.GetElementById("submit").InvokeMember("click")
End If
End Sub
And here is the HTML code:
<input type="file" id="fileselect" name="fileselect[]" multiple="multiple" />
<button type="submit" id="submit" class="uploadButton">Upload Files</button>
Also how do i make so that i can select multiple files? Via the web version you can select multiple files and it workes not not here?
So, as mentioned in the comments, input elements of type file do not allow for external modification, all interaction with them is done through the browser and is based on direct user interaction.
However, you could create an upload class that process the multiple file upload to your server, by creating a HttpWebRequest, which sends the data to the form. Provided there is no authentication, it can be done in the following way.
An interface that allows for some elementary actions for post data items
Public Interface IPostItem
ReadOnly Property Title As String
Property ElementName As String
Function GetPostData(inputNameElement As String) As String
End Interface
Some way to define the mime type of the file being sent
Public NotInheritable Class MimeTypeHandler
Private Shared ReadOnly images As String() = {"jpg", "gif", "bmp", "png", "jpeg"}
Public Shared Function GetMimeType(filename As String) As String
Dim extension As String = Path.GetExtension(filename).Replace(".", "")
If (images.Contains(extension)) Then
Return "image/" + extension
End If
Return "application/" + extension
End Function
End Class
Implement the IPostItem with an implementation that can post the file
Public Class FileQueueItem
Implements IPostItem
Public Property FileName As String
Public Property ElementName As String Implements IPostItem.ElementName
Public Function GetData() As Byte()
Dim result As Byte() = Nothing
Dim lengthRead As Integer = 0
Using stream As New FileStream(FileName, FileMode.Open, FileAccess.Read)
ReDim result(stream.Length)
lengthRead = stream.Read(result, 0, stream.Length)
End Using
Return result
End Function
Public ReadOnly Property ShortName As String Implements IPostItem.Title
Get
Return FileName.Substring(FileName.LastIndexOf("\") + 1)
End Get
End Property
Public ReadOnly Property MimeType As String
Get
Return MimeTypeHandler.GetMimeType(FileName)
End Get
End Property
Public Function GetPostData(inputNameElement As String) As String Implements IPostItem.GetPostData
Dim message As String = String.Empty
message += String.Format("Content-Disposition: form-data; name=""{0}""; filename=""{1}""{3}Content-Type: {2}{3}Content-Transfer-Encoding: base64{3}{3}", inputNameElement, ShortName, MimeType, Environment.NewLine)
message += Convert.ToBase64String(GetData())
Return message
End Function
Public Sub New(filename As String, elementName As String)
Me.FileName = filename
Me.ElementName = elementName
End Sub
End Class
Have a small controller class that runs the upload sequence using the BackgroundWorker class, it sends the files per 5 (can be set, is default value).
It requires a FormUrl, to say where the form is that is being posted to, in my case, i was running it on my localhost, so that you would see in the form code
Public Class FileUploader
Inherits BackgroundWorker
Private ReadOnly _listQueue As IList(Of IPostItem) = New List(Of IPostItem)
Public Property FormUrl As String
Public ReadOnly Property ListQueue As IList(Of IPostItem)
Get
Return _listQueue
End Get
End Property
Public Property MaxPerQueue As Integer
Protected Function HandleResponse(request As HttpWebRequest) As Boolean
Dim success As Boolean = False
Try
Using response As HttpWebResponse = CType(request.GetResponse(), HttpWebResponse)
success = response.StatusCode <> HttpStatusCode.OK
End Using
Catch ex As WebException
If ex.Response IsNot Nothing Then
ex.Response.Close()
End If
End Try
Return success
End Function
Protected Sub Run(sender As Object, e As DoWorkEventArgs)
If ListQueue.Count = 0 Then
' nothing to upload
Return
End If
' create the boundary string, used to split between the separate attachments
Dim boundary As String = String.Format("--------------------------{0}", DateTime.Now.Ticks)
Dim count As Integer = 0
Dim totalFiles As Integer = ListQueue.Count
Do
' create the request
Dim request As HttpWebRequest = CType(WebRequest.Create(Me.FormUrl), HttpWebRequest)
Dim fullPostMessage As String = String.Empty
request.AllowAutoRedirect = True
request.KeepAlive = True
request.Referer = Me.FormUrl
''// say that it has to post data
request.Method = WebRequestMethods.Http.Post
''// same style like a form
request.ContentType = "multipart/form-data;boundary=" + boundary
count = 0
Dim queueItem As IPostItem
While count < MaxPerQueue AndAlso ListQueue.Count > 0
''// get the item in the queue
queueItem = ListQueue(0)
''// report potential changes to gui
Report(queueItem.Title, count, totalFiles)
Dim postAsString As String = queueItem.GetPostData(queueItem.ElementName)
fullPostMessage &= String.Format("--{0}{1}{2}{1}", boundary, Environment.NewLine, postAsString)
''// remove the item from the queue
ListQueue.RemoveAt(0)
count += 1
End While
fullPostMessage &= "--" & boundary & "--"
Dim postData As Byte() = System.Text.Encoding.ASCII.GetBytes(fullPostMessage)
''// write data to the requestStream (post data)
request.ContentLength = postData.Length
Dim requestStream As Stream = request.GetRequestStream()
requestStream.Write(postData, 0, postData.Length)
requestStream.Close()
''// handle the response
HandleResponse(request)
requestStream.Dispose()
Loop While ListQueue.Count > 0
ListQueue.Clear()
Report("(Idle)", 0, 100)
End Sub
Protected Sub Report(filename As String, fileIndex As Integer, maxFiles As Integer)
Dim percentage As Integer = (fileIndex * 100) / maxFiles
ReportProgress(percentage, filename)
End Sub
Public Sub New()
Me.WorkerReportsProgress = True
AddHandler Me.DoWork, AddressOf Run
MaxPerQueue = 5
End Sub
End Class
Then you could create your form like this:
And then add the FileUploader class as a private member, so you can get notified when it has completed the upload stream, add the eventhandlers to get notified on the changes
Imports System.ComponentModel
Imports System.Net
Imports System.IO
Public Class Form1
Private fileUploadHandler As New FileUploader()
Private Sub btnUploadFiles_Click(sender As Object, e As EventArgs) Handles btnUploadFiles.Click
fileUploadHandler.FormUrl = "http://localhost:5555/Default.aspx"
Using openDialog As New OpenFileDialog
openDialog.Multiselect = True
openDialog.Title = "Select files to upload to the server"
If openDialog.ShowDialog() Then
' all files are selected
For Each fileName As String In openDialog.FileNames
Dim qItem As IPostItem = New FileQueueItem(fileName, "fileInfo[]")
fileUploadHandler.ListQueue.Add(qItem)
Next
btnUploadFiles.Enabled = False
fileUploadHandler.RunWorkerAsync()
End If
End Using
End Sub
Private Sub OnUploadCompleted(sender As Object, e As RunWorkerCompletedEventArgs)
btnUploadFiles.Enabled = True
End Sub
Private Sub OnReportProgress(sender As Object, e As ProgressChangedEventArgs)
pbUploadProgress.Value = e.ProgressPercentage
lblUploadProgress.Text = e.UserState
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
AddHandler fileUploadHandler.RunWorkerCompleted, AddressOf OnUploadCompleted
AddHandler fileUploadHandler.ProgressChanged, AddressOf OnReportProgress
End Sub
End Class
The files get then uploaded as soon as you click the Open button in the OpenFileDialog.
As to your second question, to allow for more than 1 file selected, you have to set the OpenFileDialog.Multiselect = True flag

Super slow HttpWebRequest

I'm making a website scraper for a project I'm doing. I've gotten everything to work great, however, loading the actual page takes F-O-R-E-V-E-R. You can see the page it's loading here:
MCServerList.Net
Here is the code I am using:
private CONST REQUESTURL as string = "http://www.MCServerList.net/?page="
private chunkId as int32 = 1
Dim req As HttpWebRequest = WebRequest.Create(REQUESTURL & chunkId)
Dim res As HttpWebResponse = req.GetResponse()
Dim Stream As Stream = res.GetResponseStream()
I then use "Stream" and load it through the HTMLAgilityPack found free online. It loads the page quickly, however, the initial request usually takes ~20-30 seconds.
Any help would be appreciated!
I just ran the following code and ignoring the first initial compile I average about 3.3 seconds for GetResponse() and 0.2 more seconds for Load(). Are you on a fast connection? Are you sure this is where the bottleneck is?
Option Explicit On
Option Strict On
Imports System.Net
Public Class Form1
Private Const REQUESTURL As String = "http://www.MCServerList.net/?page="
Private chunkId As Int32 = 1
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim ST As New System.Diagnostics.Stopwatch()
ST.Start()
Dim req = WebRequest.Create(REQUESTURL & chunkId)
Dim res = req.GetResponse()
Trace.WriteLine(String.Format("GetResponse() : {0}", ST.Elapsed))
Using Stream As System.IO.Stream = res.GetResponseStream()
Dim X As New HtmlAgilityPack.HtmlDocument()
X.Load(Stream)
End Using
Trace.WriteLine(String.Format("Load() : {0}", ST.Elapsed))
ST.Stop()
End Sub
End Class