Problem with Crunch occurring after some time FtpWebRequest in vb.net - 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

Related

How to execute a webrequest asynchronous to parse json

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

itextsharp search pdf and extract found pages to another pdf

Can anyone show me how to extract pages based on page numbers found in search and create new pdf to be able to print? What I have in mind is I will search a pdf using vb.net and the pages that have my answer will be extracted to another pdf and in the end of search it will print the new pdf. What I have done till now is I have done the search and it returns page number for the correct results, but I dont know from here what to do please see below:
Public Shared Function SearchTextFromPdf(ByVal sourcePdf As String, ByVal searchPhrase As String, Optional ByVal caseSensitive As Boolean = False) As List(Of Integer)
Dim fBrowse As New OpenFileDialog
With fBrowse
.Filter = "PDF Files(*.pdf)|*.pdf|All Files(*.*)|*.*"
.Title = "Choose Pdf"
End With
If fBrowse.ShowDialog() = Windows.Forms.DialogResult.OK Then
sourcePdf = fBrowse.FileName
Else
Exit Function
End If
Dim foundList As New List(Of Integer)
Dim raf As iTextSharp.text.pdf.RandomAccessFileOrArray = Nothing
Dim reader As iTextSharp.text.pdf.PdfReader = Nothing
Try
raf = New iTextSharp.text.pdf.RandomAccessFileOrArray(sourcePdf)
reader = New iTextSharp.text.pdf.PdfReader(raf, Nothing)
If caseSensitive = False Then
searchPhrase = searchPhrase.ToLower()
End If
For i As Integer = 1 To reader.NumberOfPages()
Dim pageText As String = iTextSharp.text.pdf.parser.PdfTextExtractor.GetTextFromPage(reader, i)
If caseSensitive = False Then
pageText = pageText.ToLower()
End If
If pageText.Contains(searchPhrase) Then
MsgBox(i)
foundList.Add(i)
End If
Next
reader.Close()
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
Return foundList
End Function
You can use the following code:
Imports iTextSharp.text.pdf.parser
Imports iTextSharp.text.pdf
Imports iTextSharp.text
Imports System.IO
Public Class Form1
Dim sourceFile As String = "D:\source.pdf"
Dim resultFile As String = "D:\result.pdf"
Dim arrayOfPages As Integer() = {1, 5, 7, 9}
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
ExtractPages(sourceFile, arrayOfPages)
End Sub
Public Sub ExtractPages(sourcePdfFile As String, pagesForExtracting As Integer())
Dim reader As New PdfReader(sourcePdfFile)
Dim document As New Document(reader.GetPageSize(1))
Dim pdfCopy As New PdfCopy(document, New FileStream(resultFile, FileMode.Create))
Try
document.Open()
For Each pageNumber As Integer In pagesForExtracting
Dim importedPage As PdfImportedPage = pdfCopy.GetImportedPage(reader, pageNumber)
pdfCopy.AddPage(importedPage)
Next
Dim text As String = PdfTextExtractor.GetTextFromPage(reader, 1, New iTextSharp.text.pdf.parser.SimpleTextExtractionStrategy())
document.Close()
reader.Close()
Catch ex As Exception
Throw ex
End Try
End Sub
End Class
If pdfCopy throws null reference exception - you have to ignore this exception, choosing Continue in Visual Studio IDE

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!

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

Reporting Progress for a CopyToAsync Operation

Is there a way to report progress on a CopyToAsync operation on a FileStream? As far as I can tell there are no Events listed for a FileStream object so I can't add a handler to it. The best examples I've found deal with DownloadProgressChanged/DownloadFileComplete for WebClient objects.
For i As Int32 = 0 To strFileList.Count - 1
Try
Using srmSource As FileStream = File.Open(dirSource + strFileList(i), FileMode.Open)
Using srmDestination As FileStream = File.Create(dirDestination + strFileList(i))
Me.lblStatus.Text = "Copying file - " & strFileList(i) & "..."
Await srmSource.CopyToAsync(srmDestination)
End Using
End Using
Me.lblStatus.Text = "Copying complete!"
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
Next
Here's what I came up with using these links as references:
http://blogs.msdn.com/b/dotnet/archive/2012/06/06/async-in-4-5-enabling-progress-and-cancellation-in-async-apis.aspx (converted from C# to VB.NET)
http://social.msdn.microsoft.com/Forums/en-US/8c121fef-ebc7-42ab-a2f8-3b5e9a6e9854/delegates-with-parameter?forum=vbide
Imports System.IO
Imports System.Net
Imports System.Threading.Tasks
Public Class frmStartup
Private Async Sub frmStartup_Load(sender As Object, e As EventArgs) Handles Me.Load
Dim FileList As List(Of String) = GetFilesToTransfer()
If FileList.Count > 0 Then
UpdateLabel("Found files to transfer...")
Me.prgTransfer.Visible = True
Try
Dim ProgressIndicator As Object = New Progress(Of Int32)(AddressOf ReportProgress)
Await TransferFiles(FileList, ProgressIndicator)
UpdateLabel("File transfer complete!")
Catch ex As Exception
UpdateLabel("Error transferring files!")
Finally
Me.prgTransfer.Visible = False
End Try
End If
End Sub
Private Function GetFilesToTransfer() As List(Of String)
Dim strFilesToTransfer As List(Of String) = New List(Of String)
strFilesToTransfer.Add("aud1.mp3")
strFilesToTransfer.Add("aud2.mp3")
Return strFilesToTransfer
End Function
Public Async Function TransferFiles(ByVal FileList As List(Of String), ByVal Progress As IProgress(Of Int32)) As Task
Dim intTotal As Int32 = FileList.Count
Dim dirSource As String = "\\source\"
Dim dirDestination As String = "c:\destination\"
Await Task.Run(Async Function()
Dim intTemp As Int32 = 0
For i As Int32 = 0 To FileList.Count - 1
UpdateLabel("Copying " & FileList(i) & "...")
Using srmSource As FileStream = File.Open(dirSource + FileList(i), FileMode.Open)
Using srmDestination As FileStream = File.Create(dirDestination + FileList(i))
Await srmSource.CopyToAsync(srmDestination)
End Using
End Using
intTemp += 1
If Progress IsNot Nothing Then
Progress.Report((intTemp * 100 / intTotal))
End If
Next
End Function)
End Function
Private Delegate Sub UpdateLabelInvoker(ByVal LabelText As String)
Private Sub UpdateLabel(ByVal LabelText As String)
If Me.lblStatus.InvokeRequired Then
Me.lblStatus.Invoke(New UpdateLabelInvoker(AddressOf UpdateLabel), LabelText)
Else
Me.lblStatus.Text = LabelText
End If
End Sub
Private Sub ReportProgress(ByVal Value As Int32)
Me.prgTransfer.Value = Value
End Sub
End Class