WebBrowser, handle pdf load complete - vb.net

I was wondering if anyone knew an easy way to have .pdf files trigger the readystate when loaded. I'm building a program to open url's and take screenshots, then put them in excel.
The web browser will load html documents correctly, but gets stuck in While Not pageready when loading .pdf files. The browser control correctly renders the .pdf.
Private Sub btngo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btngo.Click
Dim file As String
Dim Obj As New Object
Dim result As String
Dim sheet As String = "sheet1"
Dim xlApp As New Excel.Application
If lblpath.Text <> "" Then
file = lblpath.Text
Dim xlWorkBook = xlApp.Workbooks.Open(file)
Dim xlWorkSheet = xlWorkBook.Worksheets(sheet)
Dim range = xlWorkSheet.UsedRange
ProgressBar1.Value = 0
For rCnt = 4 To range.Rows.Count
'url cell
Obj = CType(range.Cells(rCnt, 2), Excel.Range)
' Obj.value now contains the value in the cell..
Try
' Creates an HttpWebRequest with the specified URL.
Dim myHttpWebRequest As HttpWebRequest = CType(WebRequest.Create(Obj.value), HttpWebRequest)
' Sends the request and waits for a response.
Dim myHttpWebResponse As HttpWebResponse = CType(myHttpWebRequest.GetResponse(), HttpWebResponse)
If myHttpWebResponse.StatusCode = HttpStatusCode.OK Then
result = myHttpWebResponse.StatusCode
WebBrowser1.ScrollBarsEnabled = False
WebBrowser1.Navigate(myHttpWebRequest.RequestUri)
WaitForPageLoad()
CaptureWebBrowser(WebBrowser1)
End If
' Release the resources of the response.
myHttpWebResponse.Close()
Catch ex As WebException
result = (ex.Message)
Catch ex As Exception
result = (ex.Message)
End Try
RichTextBox1.AppendText(result & " " & Obj.value & vbNewLine)
If radpre.Checked = True Then
range.Cells(rCnt, 3).value = result
ElseIf radcob.Checked = True Then
range.Cells(rCnt, 4).value = result
ElseIf radpost.Checked = True Then
range.Cells(rCnt, 5).value = result
End If
ProgressBar1.Value = rCnt / range.Rows.Count * 100
Next
With xlApp
.DisplayAlerts = False
xlWorkBook.SaveAs(lblpath.Text.ToString)
.DisplayAlerts = True
End With
xlWorkBook.Close()
xlApp.Quit()
'reclaim memory
Marshal.ReleaseComObject(xlApp)
xlApp = Nothing
End If
End Sub
Private Function CaptureWebBrowser(ByVal wb As WebBrowser) As Image
Try
Dim hBitmap As Bitmap = New Bitmap(wb.Width, wb.Height)
wb.DrawToBitmap(hBitmap, wb.Bounds)
Dim img As Image = hBitmap
Return img
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
Return Nothing
End Function
Private Sub WaitForPageLoad()
AddHandler WebBrowser1.DocumentCompleted, New WebBrowserDocumentCompletedEventHandler(AddressOf PageWaiter)
While Not pageready
Application.DoEvents()
End While
pageready = False
End Sub
Private Sub PageWaiter(ByVal sender As Object, ByVal e As WebBrowserDocumentCompletedEventArgs)
If WebBrowser1.ReadyState = WebBrowserReadyState.Complete Then
pageready = True
RemoveHandler WebBrowser1.DocumentCompleted, New WebBrowserDocumentCompletedEventHandler(AddressOf PageWaiter)
End If
End Sub
update to resolved
I'm very happy with the feedback. I really like like the answer Noseratio provided. I was not aware using the code pattern as not in best practices. When opening a .pdf or any other document not web based readyState will never change from 0. Seeing how this program is simply a way for me not to work at work, I'm satisfied with only capturing .html and .htm.
My requirements were
open excel document
parse links located in excel document
determine response code
write response code and if possible screenshot to excel
The program parses and retrieves feedback far faster then I would be able to do manually. Screenshots of .html and .htm provide non-technical viewers of the excel file proof of successful migration from production to COB, and back to production environments.
This code as stated by Noseratio does not follow best practices, nor is it high quality. This is a quick and dirty implementation.
Option Infer On
Imports Microsoft.Office.Interop
Imports System.Net
Imports System.Runtime.InteropServices
Public Class Form1
Public Property pageready As Boolean
Private Sub OpenToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles OpenToolStripMenuItem.Click
OpenFileDialog1.ShowDialog()
End Sub
Private Sub OpenFileDialog1_FileOk(ByVal sender As System.Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles OpenFileDialog1.FileOk
lblpath.Text = OpenFileDialog1.FileName.ToString
End Sub
Private Sub btngo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btngo.Click
Dim file As String
Dim Obj As New Object
Dim result As String
Dim sheet As String = "sheet1"
Dim xlApp As New Excel.Application
Dim img As Bitmap
Dim path As String = "C:\Documents and Settings\user\My Documents\Visual Studio 2010\Projects\COB-HTML-Tool\COB-HTML-Tool\bin\Debug\tmp.bmp"
If lblpath.Text <> "" Then
file = lblpath.Text
Dim xlWorkBook = xlApp.Workbooks.Open(file)
Dim xlWorkSheet = xlWorkBook.Worksheets(sheet)
Dim range = xlWorkSheet.UsedRange
ProgressBar1.Value = 0
For rCnt = 4 To range.Rows.Count
'url cell
Obj = CType(range.Cells(rCnt, 2), Excel.Range)
' Obj.value now contains the value in the cell..
Try
' Creates an HttpWebRequest with the specified URL.
Dim myHttpWebRequest As HttpWebRequest = CType(WebRequest.Create(Obj.value), HttpWebRequest)
' Sends the request and waits for a response.
Dim myHttpWebResponse As HttpWebResponse = CType(myHttpWebRequest.GetResponse(), HttpWebResponse)
If myHttpWebResponse.StatusCode = HttpStatusCode.OK Then
result = myHttpWebResponse.StatusCode
Dim len As Integer = myHttpWebRequest.RequestUri.ToString.Length - 4
If myHttpWebRequest.RequestUri.ToString.Substring(len) = ".htm" Or
myHttpWebRequest.RequestUri.ToString.Substring(len - 1) = ".html" Or
myHttpWebRequest.RequestUri.ToString.Substring(len) = ".asp" Then
WebBrowser1.Navigate(myHttpWebRequest.RequestUri)
WaitForPageLoad()
img = CaptureWebBrowser(WebBrowser1)
img.Save(path)
End If
End If
' Release the resources of the response.
myHttpWebResponse.Close()
Catch ex As WebException
result = (ex.Message)
Catch ex As Exception
result = (ex.Message)
End Try
RichTextBox1.AppendText(result & " " & Obj.value & vbNewLine)
If radpre.Checked = True Then
range.Cells(rCnt, 3).value = result
If img Is Nothing Then
Else
If Dir(path) <> "" Then
range.Cells(rCnt, 4).Select()
Dim opicture As Object
opicture = xlApp.ActiveSheet.Pictures.Insert(path)
opicture.ShapeRange.LockAspectRatio = True
opicture.ShapeRange.width = 170
opicture.ShapeRange.height = 170
My.Computer.FileSystem.DeleteFile(path)
End If
End If
ElseIf radcob.Checked = True Then
range.Cells(rCnt, 5).value = result
If img Is Nothing Then
Else
If Dir(path) <> "" Then
range.Cells(rCnt, 6).Select()
Dim opicture As Object
opicture = xlApp.ActiveSheet.Pictures.Insert(path)
opicture.ShapeRange.LockAspectRatio = True
opicture.ShapeRange.width = 170
opicture.ShapeRange.height = 170
My.Computer.FileSystem.DeleteFile(path)
End If
End If
ElseIf radpost.Checked = True Then
range.Cells(rCnt, 7).value = result
If img Is Nothing Then
Else
If Dir(path) <> "" Then
range.Cells(rCnt, 8).Select()
Dim opicture As Object
opicture = xlApp.ActiveSheet.Pictures.Insert(path)
opicture.ShapeRange.LockAspectRatio = True
opicture.ShapeRange.width = 170
opicture.ShapeRange.height = 170
My.Computer.FileSystem.DeleteFile(path)
End If
End If
End If
ProgressBar1.Value = rCnt / range.Rows.Count * 100
Next
With xlApp
.DisplayAlerts = False
xlWorkBook.SaveAs(lblpath.Text.ToString)
.DisplayAlerts = True
End With
xlWorkBook.Close()
xlApp.Quit()
'reclaim memory
Marshal.ReleaseComObject(xlApp)
xlApp = Nothing
End If
End Sub
Private Function CaptureWebBrowser(ByVal wb As WebBrowser) As Image
Try
wb.ScrollBarsEnabled = False
Dim hBitmap As Bitmap = New Bitmap(wb.Width, wb.Height)
wb.DrawToBitmap(hBitmap, wb.Bounds)
Dim img As Image = hBitmap
Return img
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
Return Nothing
End Function
Private Sub WaitForPageLoad()
AddHandler WebBrowser1.DocumentCompleted, New WebBrowserDocumentCompletedEventHandler(AddressOf PageWaiter)
While Not pageready
Application.DoEvents()
System.Threading.Thread.Sleep(200)
End While
pageready = False
End Sub
Private Sub PageWaiter(ByVal sender As Object, ByVal e As WebBrowserDocumentCompletedEventArgs)
If WebBrowser1.ReadyState = WebBrowserReadyState.Complete Then
pageready = True
RemoveHandler WebBrowser1.DocumentCompleted, New WebBrowserDocumentCompletedEventHandler(AddressOf PageWaiter)
End If
End Sub
End Class

Unfortunately, you won't be able to use webBrowser.DrawToBitmap to get a snapshot of the PDF view. At the time of writing this, Adobe Acrobat Reader ActiveX control doesn't support rendering on a custom device context, so this method won't work, as well as sending WM_PRINT or calling IViewObject::Draw, either directly on the Reader ActiveX object on via WebBrowser (I tried that, and I'm not alone). The proper solution would be to use a 3rd party PDF rendering component.
On a side note, you should avoid using code pattern like this:
While Not pageready
Application.DoEvents()
End While
It's a busy waiting tight loop, consuming CPU cycles in vain. At least, put some Thread.Sleep(200) inside the loop, but overall you should avoid using Application.DoEvents too.

Related

Threading doesn't complete the task before ending the thread loop

So I did something similar a while ago, but this is essentially a username checker for a (specific) website, they can load in usernames via text file and it will put it into a list box, now I have the start button and it's meant to check each username. Before, however, it froze the program when they checked, but it worked. I tried making it "threaded" so it didn't freeze.
The problem now is that it doesn't check them all, and finishes instantly.
CODE:
Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click
Button6.Enabled = False
Dim goodUsers As New SaveFileDialog()
goodUsers.Filter = "TXT file (*.txt)|*.txt"
Dim flag As Boolean
Dim Incomplete As Integer = 0
Dim Taken As Integer = 0
Dim sb As New StringBuilder
If goodUsers.ShowDialog() = DialogResult.OK Then
Dim checkerMT As New Thread(
Sub()
For Each i As String In UsernameList.Items
WebRequest.Create("http://yatobooter.cf/other/checkusr.php?username=" + i.ToString)
Dim cResult As String = New System.Net.WebClient().DownloadString("http://yatobooter.cf/other/checkusr.php?username=" + i.ToString).ToString
If cResult = "taken" Then
flag = False
ElseIf cResult = "nottaken" Then
flag = True
End If
If flag = True Then
sb.Append(i & vbNewLine)
Else
Incomplete = Incomplete + 1
Taken = UsernameList.Items.Count - Incomplete
End If
Next
End Sub
)
checkerMT.Start()
Try
File.WriteAllText(goodUsers.FileName, sb.ToString)
Catch ex As Exception
Exit Sub
End Try
End If
MessageBox.Show("Checking available usernames, complete!", "NameSniper Pro")
Button6.Enabled = True
End Sub
You cannot access UI elements (UsernameList.Items) from a thread other than the UI. Instead add a background worker to your form to handle the basic threading stuff (progress reporting, finish reporting, exception handling). Pass into this an object that contains the settings your job needs to do its work without interacting with the ui.
Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click
Button6.Enabled = False
Dim goodUsers As New SaveFileDialog()
goodUsers.Filter = "TXT file (*.txt)|*.txt"
If goodUsers.ShowDialog() = DialogResult.OK Then
'Note: You'll need to add the filenames
BackgroundWorker1.RunWorkerAsync(New State() With {.Names = {}, .FileName = goodUsers.FileName})
End If
End Sub
Class State
Public Names As List(Of String)
Public StringBuilder As New System.Text.StringBuilder
Public Incomplete As Integer
Public Taken As Integer
Public FileName As String
End Class
Private Sub BackgroundWorker1_DoWork(sender As System.Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
Dim state = CType(e.Argument, State)
For Each i As String In state.Names
Using cli = New System.Net.WebClient()
Dim cResult = cli.DownloadString("http://yatobooter.cf/other/checkusr.php?username=" + i.ToString).ToString
If cResult = "nottaken" Then
state.StringBuilder.Append(i & vbNewLine)
Else
state.Incomplete = state.Incomplete + 1
state.Taken = state.Names.Count - state.Incomplete
End If
End Using
Next
IO.File.WriteAllText(state.FileName, state.StringBuilder.ToString)
End Sub
Private Sub BackgroundWorker1_RunWorkerCompleted(sender As Object, e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles BackgroundWorker1.RunWorkerCompleted
If e.Error IsNot Nothing Then
MessageBox.Show(e.Error.ToString(), "Error")
Else
MessageBox.Show("Checking available usernames, complete!", "NameSniper Pro")
End If
Button6.Enabled = True
End Sub
The SaveFileDialog can be used as "Using directive"
Why do you create a webrequest on the one hand, and on the other hand use a webclient? That does not make sense at all.
Instead of your strange if condition, write:
flag = (cResult.Equals("nottaken"))
All code you want to run after the actions you are currently running in your thread have to be in your thread as well, because it is async.
You have to invoke if you use user controls within a thread
and so on..
Please turn Option Strict On and Option Infer Off
There are lots of other things you could do better.
Please remove the webrequest and webclient combination yourself, that does not make sense at all.
Take a look at this, I cleared it a little bit:
Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click
Dim Incomplete As Integer = 0
Dim Taken As Integer = 0
Dim sb As New StringBuilder
Using goodUsers As SaveFileDialog = new SaveFileDialog()
goodUsers.Filter = "TXT file (*.txt)|*.txt"
If not goodUsers.ShowDialog() = DialogResult.OK Then Exit Sub
Dim checkerMT As New Thread(
Sub()
Me.invoke(sub()
Button6.Enabled = False
For Each i As String In UsernameList.Items
WebRequest.Create("http://yatobooter.cf/other/checkusr.php?username=" + i.ToString)
Dim cResult As String = New System.Net.WebClient().DownloadString("http://yatobooter.cf/other/checkusr.php?username=" + i.ToString).ToString
If (cResult.toLower().Equals("nottaken")) Then
sb.Append(String.Concat(i , Environment.NewLine)
Else
Incomplete += 1
Taken = UsernameList.Items.Count - Incomplete
End If
Next
File.WriteAllText(goodUsers.FileName, sb.ToString)
Button6.Enabled = True
MessageBox.Show("Checking available usernames, complete!", "NameSniper Pro")
End Sub)
End Sub
)
checkerMT.IsBackground = True;
checkerMT.Start()
End Sub

Alternate between hiding and showing different controls on form

I'm working on a small project to dynamically add browsers to a form and alternate them on a timer so every tick one browser changes from visible=true to false and so on, but can't for the life of me figure out how to do it.
'Some Variables
Dim Browsers() As WebControl
Dim XMLFile As String = "\\********.xml"
Dim Controllist As New ArrayList
Dim BrowserCount As Integer
Private Sub Left_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'Set form properties
Me.Location = New Point(Screen.AllScreens(0).Bounds.X, Screen.AllScreens(0).Bounds.Y)
Me.FormBorderStyle = Windows.Forms.FormBorderStyle.None
Me.WindowState = FormWindowState.Maximized
Me.TopMost = True
Try
'Load xml file with urls
Dim xmlDoc As New XmlDocument
Dim nodeList As XmlNodeList = xmlDoc.SelectNodes("//BottomLeft/url")
xmlDoc.Load(XMLFile)
'Define number of browsers based on xml
Dim numberOfBrowsers As Integer = nodeList.Count + 1
ReDim Browsers(numberOfBrowsers)
'Put urls in an array to use later
Dim UrlList As New ArrayList
Debug.WriteLine("Number of browser is: " & numberOfBrowsers)
For Each inst As XmlNode In nodeList
UrlList.Add(inst.InnerText)
Debug.WriteLine("Added to array: " & inst.InnerText)
Next
'Set properties and add the browsers
For counter As Integer = 0 To numberOfBrowsers - 1
Debug.WriteLine("Start adding browsers")
Browsers(counter) = New WebControl
With Browsers(counter)
Debug.WriteLine("Setting properties")
.Dock = DockStyle.Fill
.Name = "Browers" & counter
.Source = New Uri(UrlList(counter))
If counter = 0 Then
.Visible = True
Else
.Visible = False
End If
End With
'Add the actual browsers after the properties have been set
Me.Controls.Add(Browsers(counter))
AddHandler Browsers(counter).LoadingFrameComplete, AddressOf All_Browsers_Loaded
Debug.WriteLine("Browsers is added. Current Count is: " & counter)
Next
Catch ex As Exception
Debug.WriteLine(ex)
End Try
'Count all the added browsers to alternate between them
Dim allWebBrowser As New List(Of Control)
For Each web As WebControl In FindControlRecursive(allWebBrowser, Me, GetType(WebControl))
Debug.WriteLine("Webcontrols on form: " & web.Name)
BrowserCount = +1
Next
'Start timer to switch browsers
Timer1.Interval = 1000
Timer1.Start()
End Sub
Private Sub All_Browsers_Loaded(ByVal sender As System.Object, ByVal e As Awesomium.Core.FrameEventArgs)
Dim Browser As WebControl = DirectCast(sender, WebControl)
Browser.Zoom = "80"
Debug.WriteLine("Browsers is now zoomed out?")
End Sub
Public Function ChangeBrowser()
Dim Changed As Boolean
For I As Integer = 0 To BrowserCount
With Browsers(I)
If Browsers(I).Visible = True Then
Browsers(I).Visible = False
Changed = True
End If
If Changed = True Then
Browsers(I).Visible = True
Changed = False
End If
If I = BrowserCount Then
Browsers(0).Visible = True
Continue For
End If
End With
Next
Return False
End Function
In the ChangeBrowser() function I'm trying to get the first visible browser and make it not visible. Then set the Changed Boolean to true.
Whats the best way to handle this?

For Next or a different loop for URL Icon Load

I have an app that basically is a launcher for various web pages. I am trying to, OnLoad, to populate all the pictureBoxes in my form with the FavICON for each URL. 25 to be exact. Should I use a For and Next or some other kind of looping method? New to the looping part so all and any help is appreciated.
My code to load just one single PictureBox is the following:
Private Sub MainFormWPL_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'Dim WebICON As New WebBrowser
MainURLLoader.Navigate(Label1.Text)
'URLText.Text = WebBrowser1.Url.ToString
Try
Dim url As Uri = New Uri(Label1.Text)
If url.HostNameType = UriHostNameType.Dns Then
Dim icon = "http://" & url.Host & "/favicon.ico"
Dim request As System.Net.HttpWebRequest = System.Net.HttpWebRequest.Create(icon)
Dim response As System.Net.HttpWebResponse = request.GetResponse()
Dim stream As System.IO.Stream = response.GetResponseStream
Dim favicon = Image.FromStream(stream)
PictureBox1.Image = favicon
Else
End If
Catch ex As Exception
End Try
End Sub
Assuming you have Label1 --> PictureBox1, all the way to Label25 --> PictureBox25:
Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim matches() As Control
For i As Integer = 1 To 25
matches = Me.Controls.Find("Label" & i, True)
If matches.Length > 0 Then
Dim website As String = matches(0).Text
matches = Me.Controls.Find("PictureBox" & i, True)
If matches.Length > 0 AndAlso TypeOf matches(0) Is PictureBox Then
Dim PB As PictureBox = DirectCast(matches(0), PictureBox)
Task.Run(New Action(Sub() GetFavIcon(website, PB)))
End If
End If
Next
End Sub
Private Sub GetFavIcon(ByVal website As String, ByVal PB As PictureBox)
Dim url As Uri = New Uri(website)
If url.HostNameType = UriHostNameType.Dns Then
Dim icon = "http://" & url.Host & "/favicon.ico"
Dim request As System.Net.HttpWebRequest = System.Net.HttpWebRequest.Create(icon)
Dim response As System.Net.HttpWebResponse = request.GetResponse()
Dim stream As System.IO.Stream = response.GetResponseStream
Dim favicon = Image.FromStream(stream)
PB.Invoke(New MethodInvoker(Sub() PB.Image = favicon))
response.Close()
End If
End Sub
End Class

Trying to change a timer once a button is pressed

I have a check going every 60 seconds, if the alarm is true it will open form2 play a song etc.
but the button on form2 should set the waittimer = 180000 which should make the next check occur half an half an hour later.
I'm not used to using timers, what am I doing wrong?
Public Class Form1
Public Property waittimer As Integer
Public Property playsong As Boolean = True
Private WithEvents Tmr As New Timer
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
If (Process.GetProcessesByName(Process.GetCurrentProcess.ProcessName).Length > 1) Then
Application.Exit()
End If
Tmr.Enabled = False
Tmr.Interval = TimeSpan.FromSeconds(60).TotalMilliseconds
BackgroundWorker1.RunWorkerAsync()
End Sub
Private Sub NotifyIcon1_MouseDoubleClick(sender As Object, e As MouseEventArgs) Handles NotifyIcon1.MouseDoubleClick
playsong = False
Try
' Create a request for the URL.
Dim request As WebRequest = _
WebRequest.Create("http://example.com/example.aspx")
' If required by the server, set the credentials.
request.Credentials = CredentialCache.DefaultCredentials
' Get the response.
Dim response As WebResponse = request.GetResponse()
' Display the status.
Console.WriteLine(CType(response, HttpWebResponse).StatusDescription)
' Get the stream containing content returned by the server.
Dim dataStream As Stream = response.GetResponseStream()
' Open the stream using a StreamReader for easy access.
Dim reader As New StreamReader(dataStream)
' Read the content.
Dim responseFromServer As String = reader.ReadToEnd()
' Display the content.
Console.WriteLine(responseFromServer)
' Clean up the streams and the response.
reader.Close()
response.Close()
Dim responseArray() As String
responseArray = Split(responseFromServer, "|")
Dim D As New Data
D.maxcalls = responseArray(0)
D.cph = responseArray(1)
D.mht = responseArray(2)
D.alarm = responseArray(3)
Form2.startsong(D)
Catch ex As Exception
End Try
playsong = True
End Sub
Private Sub ExitToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles ExitToolStripMenuItem.Click
Application.Exit()
End
End Sub
Private Sub BackgroundWorker1_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
Try
If waittimer = 180000 Then
Tmr.Interval = waittimer
Tmr.Start()
waittimer = 60000
Else
waittimer = 60000
End If
' Create a request for the URL.
Dim request As WebRequest = _
WebRequest.Create("http://example.com/example.aspx")
' If required by the server, set the credentials.
request.Credentials = CredentialCache.DefaultCredentials
' Get the response.
Dim response As WebResponse = request.GetResponse()
' Display the status.
Console.WriteLine(CType(response, HttpWebResponse).StatusDescription)
' Get the stream containing content returned by the server.
Dim dataStream As Stream = response.GetResponseStream()
' Open the stream using a StreamReader for easy access.
Dim reader As New StreamReader(dataStream)
' Read the content.
Dim responseFromServer As String = reader.ReadToEnd()
' Display the content.
Console.WriteLine(responseFromServer)
' Clean up the streams and the response.
reader.Close()
response.Close()
Dim responseArray() As String
responseArray = Split(responseFromServer, "|")
Dim D As New Data
D.maxcalls = responseArray(0)
D.cph = responseArray(1)
D.mht = responseArray(2)
D.alarm = responseArray(3)
D.forcealarm = False
e.Result = D
Catch ex As Exception
Dim D As New Data
D.maxcalls = 404
D.cph = 404
D.mht = 404
D.alarm = True
D.forcealarm = True
e.Result = D
End Try
Tmr.Interval = waittimer
End Sub
Private Sub BackgroundWorker1_RunWorkerCompleted(sender As Object, e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles BackgroundWorker1.RunWorkerCompleted
If Not IsNothing(e.Result) Then
Dim strtime As String
Dim englandtime = System.TimeZoneInfo.ConvertTime(Now, TimeZoneInfo.FindSystemTimeZoneById("UTC"))
strtime = DatePart(Microsoft.VisualBasic.DateInterval.Hour, englandtime) & DatePart(Microsoft.VisualBasic.DateInterval.Minute, englandtime)
Dim D As Data = DirectCast(e.Result, Data)
If D.forcealarm = True Then
Form2.startsong(D)
End If
If D.alarm Then
If strtime < 730 And strtime > 0 Then
Else
Form2.startsong(D)
End If
End If
End If
Tmr.Start()
End Sub
Private Sub Tmr_Tick(sender As Object, e As System.EventArgs) Handles Tmr.Tick
Tmr.Stop()
BackgroundWorker1.RunWorkerAsync()
End Sub
End Class
Public Class Data
Public Property maxcalls As Integer
Public Property cph As Integer
Public Property mht As Integer
Public Property alarm As Boolean
Public Property forcealarm As Boolean
End Class
Form2
Public Class Form2
Public audio As New AudioFile(My.Application.Info.DirectoryPath & "\Help.mp3")
Public Sub startsong(ByVal D As Data)
Me.Show()
MHTvalue.Text = D.mht.ToString
Maxcallsvalue.Text = D.maxcalls
CPHvalue.Text = D.cph
If Form1.playsong = True Then
audio.Play()
End If
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
' Me.Close()
audio.Stop()
Form1.waittimer = 180000
End Sub
Private Sub Form2_Closing(sender As Object, e As EventArgs) Handles MyBase.Load
audio.Stop()
Form1.waittimer = 180000
End Sub
Private Sub Form2_Minimize(sender As Object, e As EventArgs) Handles MyBase.Load
audio.Stop()
Form1.waittimer = 180000
End Sub
Thats probably because your timer on the original form1 instance never get re configured by your code. You are instead setting a timer on a new copy of form 1 that is not running (showing).
You need to get the running instance of form1 that you originally opened. A technique I use for something like this, is to tag my form I will be looking for, and then stepping through the form instances currently running, getting my form via its tag, setting that found form equal to the object I am working with, and THEN use the properties/methods of that form.
Set your form1's tag to "myTag".
Then on form 2:
For Each f As Form In My.Application.OpenForms
If Not f.InvokeRequired Then
'Can access the form directly.
If f.Tag = "myTag" Then
'this is my form
Dim fcast As New form1
fcast = f
fcast.<---- use your methods / properties...
End If
End If
Next
Just change:
Public Property waittimer As Integer
To:
Public Property waittimer As Integer
Get
Return Tmr.Interval
End Get
Set(value As Integer)
If value > 0 Then
Tmr.Interval = value
End If
End Set
End Property
You were changing the waittimer value, but not the actual Interval() of the Timer as well. This links the two together.

ThreadState always is "Unstarted"

When I start a thread, the ThreadState always is "Unstarted" even if I do a "Thread.Abort()", my thread starts and finish the work good... I don't know why I get that always the same state.
Dim thread_1 As System.Threading.Thread = New Threading.Thread(AddressOf mithread)
thread_1.Start()
System.Threading.Thread.Sleep(100)
While not thread_1.ThreadState = Threading.ThreadState.Running
MsgBox(thread_1.ThreadState.ToString) ' "Unstarted"
thread_1.Abort()
MsgBox(thread_1.ThreadState.ToString) ' "Unstarted" again and again...
End While
UPDATE
This is the sub who calls the thread, and the problem is the "while" statament is not waiting,
PS: You can see a comment explanation at the middle of this sub:
public sub...
...
If Not playerargs = Nothing Then
If randomize.Checked = True Then
Dim thread_1 As System.Threading.Thread = New Threading.Thread(AddressOf mithread)
thread_1.Start()
System.Threading.Thread.Sleep(50)
While thread_1.ThreadState = Threading.ThreadState.Running
Windows.Forms.Application.DoEvents()
End While
Else
progresslabel.Text = "All files added..."
End If
' HERE IS THE PROBLEM, IF I CHECK "AUTOCLOSE" CHECKBOX THEN,
' THE FORM ALWAYS TRY TO CLOSE BEFORE THREAD IS COMPLETED:
' -----------------------------------------
If autoclose.Checked = True Then Me.Close()
'------------------------------------------
Else
...
End Sub
And here is the "mithread" thread:
Public Sub mithread()
Dim Str As String
Dim Pattern As String = ControlChars.Quote
Dim ArgsArray() As String
Str = Replace(playerargs, " " & ControlChars.Quote, "")
ArgsArray = Split(Str, Pattern)
Using objWriter As New System.IO.StreamWriter(Temp_file, False, System.Text.Encoding.UTF8)
Dim n As Integer = 0
Dim count As Integer = 0
Dim foldercount As Integer = -1
For Each folder In ArgsArray
foldercount += 1
If foldercount > 1 Then
InvokeControl(ProgBarPlus1, Sub(x) x.Max = foldercount)
End If
Next
If foldercount = 1 Then
For Each folder In ArgsArray
If Not folder = Nothing Then
Dim di As New IO.DirectoryInfo(folder)
Dim files As IO.FileInfo() = di.GetFiles("*")
Dim file As IO.FileInfo
InvokeControl(ProgBarPlus1, Sub(x) x.Max = files.Count)
For Each file In files
n += 1
CheckPrimeNumber(n)
count += 1
If file.Extension.ToLower = ".lnk" Then
Dim ShotcutTarget As String = Shortcut.ResolveShortcut((file.FullName).ToString())
objWriter.Write(ShotcutTarget & vbCrLf)
Else
objWriter.Write(file.FullName & vbCrLf)
End If
Next
End If
Next
ElseIf foldercount > 1 Then
For Each folder In ArgsArray
If Not folder = Nothing Then
Dim di As New IO.DirectoryInfo(folder)
Dim files As IO.FileInfo() = di.GetFiles("*")
Dim file As IO.FileInfo
InvokeControl(ProgBarPlus1, Sub(x) x.Value += 1)
For Each file In files
If file.Extension.ToLower = ".lnk" Then
Dim ShotcutTarget As String = Shortcut.ResolveShortcut((file.FullName).ToString())
objWriter.Write(ShotcutTarget & vbCrLf)
Else
objWriter.Write(file.FullName & vbCrLf)
End If
Next
End If
Next
End If
End Using
If Not thread_1.ThreadState = Threading.ThreadState.AbortRequested Then
MsgBox(thread_1.ThreadState.ToString)
Randomize_a_file.RandomizeFile(Temp_file)
InvokeControl(ProgBarPlus1, Sub(x) x.Value = 0)
' Process.Start(userSelectedPlayerFilePath, ControlChars.Quote & Temp_file.ToString() & ControlChars.Quote)
InvokeControl(progresslabel, Sub(x) x.Text = "All files launched...")
End If
End Sub
Its not easy to work out what your problem is, but i can say for sure a While Loop and DoEvents is not the way forward at all.
Instead raise an event when the thread has done all its work, subscribe to the event, and when it is raise close the form (if autoclose = true):
Public Class Form1
Public Event threadCompleted()
Public Sub New()
InitializeComponent()
AddHandler threadCompleted, AddressOf Me.Thread_Completed
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim t1 As New Threading.Thread(AddressOf mithread)
t1.Start()
End Sub
Public Sub mithread()
'simulate some work:
Threading.Thread.Sleep(3000)
'then raise the event when done
RaiseEvent threadCompleted()
End Sub
Public Delegate Sub Thread_CompletedDelegate()
Private Sub Thread_Completed()
If Me.InvokeRequired Then
Me.BeginInvoke(New Thread_CompletedDelegate(AddressOf Thread_Completed))
Else
If autoclose.Checked = True Then
Me.Close()
End If
End If
End Sub
End Class
Or use a background worker which does all this, plus handles reporting progress and cancelation all for you.
Sounds like something is happening in mithread that is preventing the thread from fully starting. I ran similar code with an empty sub for mithread and I get the expected threadstate (Stopped then Aborted).
Sub Main()
Dim thread_1 As System.Threading.Thread = New Threading.Thread(AddressOf mithread)
thread_1.Start()
System.Threading.Thread.Sleep(100)
While Not thread_1.ThreadState = Threading.ThreadState.Running
Console.WriteLine(thread_1.ThreadState.ToString)
thread_1.Abort()
Console.WriteLine(thread_1.ThreadState.ToString)
If thread_1.ThreadState = Threading.ThreadState.Aborted Then Exit While
End While
End Sub
Sub mithread()
End Sub