So I have a big web browser project and everything seems to be working just fine.
I have a feature which allows the user to get news about my website when they click a specific button.
The way this is supposed to work is it is going to read text out of a txt file in my dropbox and then display that text in a richtextbox in my application.
The way I did is that I simply uploaded a txt file into my Dropbox folder and gave it a name which never changes so as to work with my code , and then I copied the share link of this file and put it inside my code.
Now whenever I want to update my news , all I have to do is to just edit the txt file in my Dropbox folder , keeping the same file name so the link stays the same and doesn't change thus allowing my application to correctly update the news.
I tested this on my Laptop (which I do all the programming on) and it worked great. I tested this on my old desktop PC and it worked great. I had some friends from different countries around the world test this and this where the problem happens ... it worked great for some of them and for the others it failed and gave an error ... (Hostname couldn't be resolved)
Not only this makes the news function in my application not useable , but it also makes the auto update function i have not useable as well because it also uses the same method.
Now let's jump into the code and please help find out what the problem is ...
The following are the main code that works on downloading a file from Dropbox:
Private Sub Download_Dropbox(URL As String, FileName As String)
Dim Data() = HTTP_Get(URL)
File.WriteAllBytes(FileName, Data)
End Sub
Private Function HTTP_Get(Page As String) As Byte()
Dim Request As HttpWebRequest = WebRequest.Create(Page)
Request.Method = "GET"
Request.KeepAlive = True
Request.ContentType = "application/x-www-form-urlencoded"
Request.UserAgent = "Mozilla/5.0 (Windows NT 6.3) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/33.0.1750.154 Safari/537.36"
Request.AllowAutoRedirect = True
Dim Response As HttpWebResponse = Request.GetResponse()
Dim Data As Stream = Response.GetResponseStream()
Dim Bytes() As Byte
Using Writer As New MemoryStream
Dim Buffer(&HFFF) As Byte
Do
Dim BytesRead As Long = Data.Read(Buffer, 0, Buffer.Length)
If BytesRead > 0 Then Writer.Write(Buffer, 0, BytesRead) Else Exit Do
Loop
Bytes = Writer.ToArray()
End Using
Return Bytes
End Function
and this is the code for the button that tries to update the news (reads a txt file):
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
If Form1.IsConnectionAvailable = True Then
Try
'Download_Dropbox("https://www.dropbox.com/s/8m2apm0x0rh91e0/orbitnews.txt?dl=1", CurDir & "\orbitnews.txt")
Dim ABC As String
Dim myWebClient As New System.Net.WebClient
Dim file As New System.IO.StreamReader(myWebClient.OpenRead("https://www.dropbox.com/s/8m2apm0x0rh91e0/orbitnews.txt?dl=1"))
ABC = file.ReadToEnd
file.Close()
newsshower.Text = ABC
My.Settings.oldnews = ABC
dater.Text = (DateTime.Now.ToString("yyyy/MM/dd HH:mm:ss"))
My.Settings.newsrefdate = dater.Text
My.Settings.Save()
Timer1.Enabled = True
Label2.Visible = True
If newsshower.Text.Contains("Click the button below to update your browser now!") Then
If newsshower.Text.Contains(Application.ProductVersion) Then
My.Settings.newsupdate = False
updatetoggler.Visible = False
Else
updatetoggler.Visible = True
My.Settings.newsupdate = True
My.Settings.Save()
End If
End If
Catch ex As Exception
MsgBox("An error has occured while refreshing news." & vbCrLf & "Please contact customer support and send them the following:" & vbCrLf & ex.ToString & vbCrLf & vbCrLf & "Customer Support E-mail:" & vbCrLf & "omaradoinc#hotmail.com")
End Try
Else
MsgBox("You aren't connected to the internet." & vbCrLf & "Please connect to the internet to be able to refresh the news.")
End If
End Sub
and this is the code that downloads files from Dropbox (which shouls happen when the programs works on updating itself):
Public Sub mainupdate()
Download_Dropbox("https://www.dropbox.com/s/eomar7a70hokm0l/Orbit.exe?dl=1", CurDir & "\Orbit.exe")
Download_Dropbox("https://www.dropbox.com/s/ij1qceoe5kr6tmp/Orbit.exe.config?dl=1", CurDir & "\Orbit.exe.config")
Download_Dropbox("https://www.dropbox.com/s/em4mo4lsoswba4p/Orbit.pdb?dl=1", CurDir & "\Orbit.pdb")
Download_Dropbox("https://www.dropbox.com/s/g0361qpzvq74ge4/Orbit.vshost.exe?dl=1", CurDir & "\Orbit.vshost.exe")
Download_Dropbox("https://www.dropbox.com/s/o5bbkn72cbs9bo7/Orbit.vshost.exe.config?dl=1", CurDir & "\Orbit.vshost.exe.config")
Download_Dropbox("https://www.dropbox.com/s/wzsyzjczibwa9sz/Orbit.xml?dl=1", CurDir & "\Orbit.xml")
Download_Dropbox("https://www.dropbox.com/s/l0ogz6kxrn951zv/OWBV.txt?dl=1", CurDir & "\OWBV.txt")
End Sub
Public Sub othersupdate()
Download_Dropbox("https://www.dropbox.com/s/lyv0kdmpi85rbdp/libzplay.dll?dl=1", CurDir & "\libzplay.dll")
End Sub
Public Sub soundsupdate()
Download_Dropbox("https://www.dropbox.com/s/hfl1vidanwecad4/not.wav?dl=1", CurDir & "\not.wav")
Download_Dropbox("https://www.dropbox.com/s/cfroifknr8zmnub/pokked.wav?dl=1", CurDir & "\pokked.wav")
Download_Dropbox("https://www.dropbox.com/s/c73af0a30hxg7gp/screenshotsound.wav?dl=1", CurDir & "\screenshotsound.wav")
Download_Dropbox("https://www.dropbox.com/s/ps5ztudy9cwvwnl/timerend.wav?dl=1", CurDir & "\timerend.wav")
End Sub
Private Sub Download_Dropbox(URL As String, FileName As String)
Dim Data() = HTTP_Get(URL)
File.WriteAllBytes(FileName, Data)
End Sub
and this is the code for IsConnectionAvailable() in Form1 :
Public Function IsConnectionAvailable() As Boolean
Dim objUrl As New System.Uri("http://www.google.com")
Dim objWebReq As System.Net.WebRequest
objWebReq = System.Net.WebRequest.Create(objUrl)
Dim objresp As System.Net.WebResponse
Try
objresp = objWebReq.GetResponse
objresp.Close()
objresp = Nothing
Return True
Catch ex As Exception
objresp = Nothing
objWebReq = Nothing
Return False
End Try
End Function
and this is the whole code for my update client which completely failes to download any files from Dropbox or read text:
Option Explicit On
Imports System.IO
Imports System.Net
Imports System.Net.Sockets
Public Class Form1
Dim Listener As New TcpListener(8000)
Dim Client As TcpClient
Dim CurDir As String = My.Application.Info.DirectoryPath
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
updatecheck()
End Sub
Private Sub helper_Click(sender As Object, e As EventArgs) Handles helper.Click
helpform.Show()
End Sub
Public Sub mainupdate()
Download_Dropbox("https://www.dropbox.com/s/eomar7a70hokm0l/Orbit.exe?dl=1", CurDir & "\Orbit.exe")
Download_Dropbox("https://www.dropbox.com/s/ij1qceoe5kr6tmp/Orbit.exe.config?dl=1", CurDir & "\Orbit.exe.config")
Download_Dropbox("https://www.dropbox.com/s/em4mo4lsoswba4p/Orbit.pdb?dl=1", CurDir & "\Orbit.pdb")
Download_Dropbox("https://www.dropbox.com/s/g0361qpzvq74ge4/Orbit.vshost.exe?dl=1", CurDir & "\Orbit.vshost.exe")
Download_Dropbox("https://www.dropbox.com/s/o5bbkn72cbs9bo7/Orbit.vshost.exe.config?dl=1", CurDir & "\Orbit.vshost.exe.config")
Download_Dropbox("https://www.dropbox.com/s/wzsyzjczibwa9sz/Orbit.xml?dl=1", CurDir & "\Orbit.xml")
Download_Dropbox("https://www.dropbox.com/s/l0ogz6kxrn951zv/OWBV.txt?dl=1", CurDir & "\OWBV.txt")
End Sub
Public Sub othersupdate()
Download_Dropbox("https://www.dropbox.com/s/lyv0kdmpi85rbdp/libzplay.dll?dl=1", CurDir & "\libzplay.dll")
End Sub
Public Sub soundsupdate()
Download_Dropbox("https://www.dropbox.com/s/hfl1vidanwecad4/not.wav?dl=1", CurDir & "\not.wav")
Download_Dropbox("https://www.dropbox.com/s/cfroifknr8zmnub/pokked.wav?dl=1", CurDir & "\pokked.wav")
Download_Dropbox("https://www.dropbox.com/s/c73af0a30hxg7gp/screenshotsound.wav?dl=1", CurDir & "\screenshotsound.wav")
Download_Dropbox("https://www.dropbox.com/s/ps5ztudy9cwvwnl/timerend.wav?dl=1", CurDir & "\timerend.wav")
End Sub
Private Sub Download_Dropbox(URL As String, FileName As String)
Dim Data() = HTTP_Get(URL)
File.WriteAllBytes(FileName, Data)
End Sub
Private Function HTTP_Get(Page As String) As Byte()
Dim Request As HttpWebRequest = WebRequest.Create(Page)
Request.Method = "GET"
Request.KeepAlive = True
Request.ContentType = "application/x-www-form-urlencoded"
Request.UserAgent = "Mozilla/5.0 (Windows NT 6.3) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/33.0.1750.154 Safari/537.36"
Request.AllowAutoRedirect = True
Dim Response As HttpWebResponse = Request.GetResponse()
Dim Data As Stream = Response.GetResponseStream()
Dim Bytes() As Byte
Using Writer As New MemoryStream
Dim Buffer(&HFFF) As Byte
Do
Dim BytesRead As Long = Data.Read(Buffer, 0, Buffer.Length)
If BytesRead > 0 Then Writer.Write(Buffer, 0, BytesRead) Else Exit Do
Loop
Bytes = Writer.ToArray()
End Using
Return Bytes
End Function
Public Function IsConnectionAvailable() As Boolean
Dim objUrl As New System.Uri("http://www.google.com")
Dim objWebReq As System.Net.WebRequest
objWebReq = System.Net.WebRequest.Create(objUrl)
Dim objresp As System.Net.WebResponse
Try
objresp = objWebReq.GetResponse
objresp.Close()
objresp = Nothing
Return True
Catch ex As Exception
objresp = Nothing
objWebReq = Nothing
Return False
End Try
End Function
Public Sub updatecheck()
Try
If IsConnectionAvailable() = True Then
Dim request As System.Net.HttpWebRequest = System.Net.HttpWebRequest.Create("http://pastebin.com/wCt79dEc")
Dim response As System.Net.HttpWebResponse = request.GetResponse()
Dim sr As System.IO.StreamReader = New System.IO.StreamReader(response.GetResponseStream())
Dim newestversion As String = sr.ReadToEnd()
Dim fileContents As String
Try
fileContents = My.Computer.FileSystem.ReadAllText(CurDir & "\OWBV.txt")
If newestversion.Contains(fileContents) Then
updater.Enabled = False
Else
End If
Catch ex As Exception
MsgBox("Orbit version file not found. Update button disabled." & "You can do one of the following 2 methods to fix this error. (Administrator rights might be required)" & vbCrLf & "1- Please open Orbit and then head to (Settings) , then check the option (Enable Console) and save changes. " & vbCrLf & "2- Open (File) Menu and launch (Browser Console)" & vbCrLf & "3- Type in the following command without the brackets: ( /vfcreate ) and then press Enter on your keyboard." & vbCrLf & "If the process is successful , then please launch the update client again either through Orbit itself or close Orbit and launch it manually by running (OWBUpdater.exe) in the application directory. " & vbCrLf & "If the process isn't successful , then please contact customer support at: omaradoinc#hotmail.com" & vbCrLf & "The other method to fix this error is:" & vbCrLf & "1- Navigate to Orbit Installation directory/folder." & vbCrLf & "2-Create a notepad (.txt file) and name that file the following name without the brackets: (OWBV)" & vbCrLf & "3- Open the file and type Orbit's old version that you have or as instructed by customer support , save the changes." & vbCrLf & "If you fail to fix this error , please contact customer support at:" & vbCrLf & "omaradoinc#hotmail.com")
updater.Enabled = False
End Try
Else
updater.Enabled = False
repairer.Enabled = False
intnot.Visible = True
Me.Text = "Orbit Web Browser Update Client (No Internet connection)"
End If
Catch ex As Exception
MsgBox("An Error Has Occured While Checking For Updates..." & vbCrLf & "This May Happen Because Of a Load On The Server" & vbCrLf & "Please Try Again Later" & vbCrLf & "If The Problems Still Exists Then Please Report This To:" & vbCrLf & "omaradoinc#hotmail.com")
End Try
End Sub
Private Sub updater_Click(sender As Object, e As EventArgs) Handles updater.Click
Try
m1.Visible = False
m2.Visible = False
progressor.Visible = True
Me.Enabled = False
mainupdate()
Process.Start(CurDir & "\Orbit.exe")
MsgBox("Orbit was successfully updated to the latest version.")
Me.Close()
Catch ex As Exception
m1.Visible = True
m2.Visible = True
progressor.Visible = False
Me.Enabled = True
My.Computer.FileSystem.WriteAllText(CurDir & "\errorlog.txt", ex.ToString, True)
MsgBox("Update failed." & vbCrLf & "A log file was created in the application directory , Please send it to customer support at:" & vbCrLf & "omaradoinc#hotmail.com")
End Try
End Sub
Private Sub repairer_Click(sender As Object, e As EventArgs) Handles repairer.Click
Try
m1.Visible = False
m2.Visible = False
progressor.Visible = True
Me.Enabled = False
othersupdate()
soundsupdate()
Process.Start(CurDir & "\Orbit.exe")
MsgBox("Orbit was successfully repaired.")
Me.Close()
Catch ex As Exception
m1.Visible = True
m2.Visible = True
progressor.Visible = False
Me.Enabled = True
My.Computer.FileSystem.WriteAllText(CurDir & "\errorlog.txt", ex.ToString, True)
MsgBox("Repair failed." & vbCrLf & "A log file was created in the application directory , Please send it to customer support at:" & vbCrLf & "omaradoinc#hotmail.com")
End Try
End Sub
Private Sub remover_Click(sender As Object, e As EventArgs) Handles remover.Click
Try
Listener.Start()
m1.Visible = False
m2.Visible = False
progressor.Visible = True
My.Computer.FileSystem.WriteAllText(CurDir & "\uninstcmd.txt", "cmd:/send\performfactoryreset", True)
Timer1.Enabled = True
Timer1.Start()
Process.Start(CurDir & "\Orbit.exe")
updater.Enabled = False
repairer.Enabled = False
remover.Enabled = False
Catch ex As Exception
Listener.Stop()
Timer1.Stop()
Timer1.Enabled = False
m1.Visible = True
m2.Visible = True
progressor.Visible = False
MsgBox("Orbit.exe wasn't found." & vbCrLf & "Unable to complete uninstallation.")
End Try
End Sub
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
Dim Message As String
Dim nStart As Integer
Dim nLast As Integer
If Listener.Pending = True Then
Message = ""
Client = Listener.AcceptTcpClient
Dim Reader As New StreamReader(Client.GetStream())
While Reader.Peek > -1
Message &= Convert.ToChar(Reader.Read()).ToString
End While
If Message.Contains("</>") Then
nStart = InStr(Message, "</>") + 4
nLast = InStr(Message, "<\>")
Message = Mid(Message, nStart, nLast - nStart)
End If
If Message.Contains("cmd:/send\completedfactoryreset") Then
Try
My.Computer.FileSystem.WriteAllText(CurDir & "\uninstcmd.txt", "Nothing here.", True)
MsgBox("Orbit settings have been successfully cleaned." & vbCrLf & "Thanks for using Orbit , This client will now exit and launch the main uninstaller which will completely remove Orbit from your PC." & vbCrLf & "For customer support , Contact: omaradoinc#hotmail.com")
Process.Start(CurDir & "\Uninstal.exe")
Me.Close()
Catch ex As Exception
MsgBox("Orbit settings have been successfully cleaned." & vbCrLf & "Thanks for using Orbit , This client will now exit and launch the main uninstaller which will completely remove Orbit from your PC." & vbCrLf & "For customer support , Contact: omaradoinc#hotmail.com")
Process.Start(CurDir & "\Uninstal.exe")
Me.Close()
End Try
End If
End If
End Sub
End Class
For now I can't remember the line where the error was but i will try to get my friends to retest and get the exact error as i have setup my application with lots of Try Catch blocks and easy ways to grab the errors in txt files and send them to me so it shouldn't be much of a hassle before i can get the full error.
For now is there anything that seems out of space or could be improved to work better?
Related
I'm trying to get a progress bar to show while a method is being executed. I've called BackgroundWorker1.RunWorkerAsync() from a button. Then in the DoWork I call the method to run "runCopyFiles". I update the progress in ProgressChanged, and exit with RunWorkerCompleted. I'm not sure what I have wrong. I've searched the net for tutorials and examples on how to do this and have created the code from them. But the progress bar doesn't show.
Code For executing from button
Private Sub btnExecuteFileCopy_Click(sender As Object, e As EventArgs) Handles btnExecuteFileCopy.Click
Me.Refresh()
If Not BackgroundWorker1.IsBusy = True Then
BackgroundWorker1.RunWorkerAsync()
End If
End Sub
Code for BackGroundWorker
Private Sub BackgroundWorker1_DoWork(sender As Object, e As ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
BackgroundWorker1.WorkerReportsProgress = True
Const Max As Integer = 1000
For i = 1 To Max
'' do something
'' (I put a sleep to simulate time consumed)
Threading.Thread.Sleep(100)
'' report progress at regular intervals
BackgroundWorker1.ReportProgress(CInt(100 * i / Max), "Running..." & i.ToString)
'' check at regular intervals for CancellationPending
If BackgroundWorker1.CancellationPending Then
BackgroundWorker1.ReportProgress(CInt(100 * i / Max), "Cancelling...")
Exit For
End If
Next
runCopyFiles()
End Sub
Private Sub BackgroundWorker1_ProgressChanged(sender As Object, e As ProgressChangedEventArgs) Handles BackgroundWorker1.ProgressChanged
ProgressBar1.Value = e.ProgressPercentage
lblStatus.Text = e.ProgressPercentage.ToString() + " %"
End Sub
Private Sub BackgroundWorker1_RunWorkerCompleted(sender As Object, e As RunWorkerCompletedEventArgs) Handles BackgroundWorker1.RunWorkerCompleted
If e.Cancelled = True Then
MsgBox(" Operation Cancelled ")
ProgressBar1.Value = 0
lblStatus.Text = ""
ElseIf e.Error IsNot Nothing Then
MsgBox(e.Error.Message)
Else
MsgBox(" Process Complete ")
End If
End Sub
Code RunCopy
Private Sub runCopyFiles()
Application.UseWaitCursor = True
Application.DoEvents()
Me.Refresh()
Dim sFileToFind As String
Dim location As String
Dim File As String
'Dim createReportFldr As String
'Dim createXMLFldr As String
'Dim createImgFldr As String
'Directory Files are located in
location = txtFolderPath.Text
'Directory files are to copied into
MoveLocation = CopyToPath
createImgFldr = MoveLocation & "\Figures"
createReportFldr = MoveLocation & "\Reports"
createXMLFldr = MoveLocation & "\XML files"
'Create Figures Folder
If Not IO.Directory.Exists(createImgFldr) Then
IO.Directory.CreateDirectory(createImgFldr)
' MsgBox("folder created" & createFolder)
End If
'Create Reports folder
If Not IO.Directory.Exists(createReportFldr) Then
IO.Directory.CreateDirectory(createReportFldr)
'MsgBox("folder created" & createReportFldr)
End If
'Create XML folder
If Not IO.Directory.Exists(createXMLFldr) Then
IO.Directory.CreateDirectory(createXMLFldr)
' MsgBox("folder created" & createFolder)
End If
orphanedFiles = MoveLocation & "\Reports\OrphanedFilesItems.txt"
' Create or overwrite the file.
System.IO.File.Create(orphanedFiles).Dispose()
ListofFiles = MoveLocation & "\Reports\ListOfFiles.txt"
' Create or overwrite the file.
System.IO.File.Create(ListofFiles).Dispose()
MissingFiles = MoveLocation & "\Reports\MissingGraphicList.txt"
' Create or overwrite the file.
System.IO.File.Create(MissingFiles).Dispose()
Dim FILE_NAME As String
FILE_NAME = txtFileName.Text
Dim objReader As New System.IO.StreamReader(FILE_NAME)
Dim sFile As String
Do While objReader.Peek() <> -1
File = objReader.ReadLine()
sFileToFind = location & "\" & File & "*.*"
sFile = File
Dim paths() As String = IO.Directory.GetFiles(location, sFile, IO.SearchOption.AllDirectories)
If paths.Count = 0 Then
System.IO.File.AppendAllText(orphanedFiles, sFile & vbNewLine)
' Debug.Print(File)
'If System.IO.File.Exists(orphanedFiles) = True Then
' Dim objWriter As New System.IO.StreamWriter(orphanedFiles, IO.FileMode.Append)
' objWriter.WriteLine(File)
' objWriter.Close()
'Else
'MsgBox("Creating Orphaned File Now. ")
'End If
Else
For Each pathAndFileName As String In paths
Dim moveToFolder As String
If System.IO.File.Exists(pathAndFileName) = True Then
Dim sRegLast As String = pathAndFileName.Substring(pathAndFileName.LastIndexOf("\") + 1)
Dim toFileLoc As String
'MsgBox("sRegLast " & sRegLast)
' fileLoc = MoveLocation & sRegLast
moveToFolder = MoveLocation & "\XML files\" & sRegLast
toFileLoc = createXMLFldr & "\" & sRegLast
'MsgBox("FileLoc " & fileLoc)
'if toFileLoc = XML file exists move it into the XML files folder
If System.IO.File.Exists(toFileLoc) = False Then
System.IO.File.Copy(pathAndFileName, moveToFolder)
System.IO.File.AppendAllText(ListofFiles, sRegLast & vbNewLine)
End If
End If
Next
End If
Loop
'MsgBox("Files have been moved")
Call CreateGraphicsFunction(Nothing, System.EventArgs.Empty)
Call getImages()
MsgBox("Process Complete", MsgBoxStyle.DefaultButton1)
Application.UseWaitCursor = False
Application.DoEvents()
' Me.Close()
End Sub
If you loop while there are more lines in your file, there's no way to know how many total lines there are, and that is a crucial component in the percent calculation for the progress bar:
percent = 100 * currentFile / totalFiles
So instead, we can read all lines up front and iterate over them. This should be your runCopyFiles
Dim fileNames = System.IO.File.ReadAllLines(FILE_NAME)
For i = 0 To fileNames.Count() - 1
Dim fileName = fileNames(i)
sFileToFind = location & "\" & fileName & "*.*"
Dim paths = IO.Directory.GetFiles(location, fileName, IO.SearchOption.AllDirectories)
If Not paths.Any() Then
System.IO.File.AppendAllText(orphanedFiles, fileName & vbNewLine)
Else
For Each pathAndFileName As String In paths
If System.IO.File.Exists(pathAndFileName) = True Then
Dim sRegLast = pathAndFileName.Substring(pathAndFileName.LastIndexOf("\") + 1)
Dim toFileLoc = System.IO.Path.Combine(createXMLFldr, sRegLast)
Dim moveToFolder = System.IO.Path.Combine(moveLocation, "XML files", sRegLast)
'if toFileLoc = XML file exists move it into the XML files folder
If System.IO.File.Exists(toFileLoc) = False Then
System.IO.File.Copy(pathAndFileName, moveToFolder)
System.IO.File.AppendAllText(ListofFiles, sRegLast & vbNewLine)
End If
End If
Next
End If
BackgroundWorker1.ReportProgress(100 * i / fileNames.Count())
Next
That is where the progress should be reported.
And all you should have in your DoWork is this
Private Sub BackgroundWorker1_DoWork(sender As Object, e As ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
runCopyFiles()
End Sub
You never need Application.DoEvents, and if you find that you do need it, then you are doing something wrong. DoWork calls code on a background thread which
Shouldn't access the UI without invoking calls on the UI thread
In turn doesn't block the UI from updating...
... which is really why you use it - so you can run processing code behind the UI without slowing it down.
In total, here are all the things you should remember to do
Don't access UI from background thread
Use Using to automatically dispose IDisposable objects
Use System.IO.Path.Combine to combine paths instead of using string concatenation
Don't call runCopyFiles 101 times
BackgroundWorker1.ReportProgress is meant to be called when you are doing work
If booleanValue = True Then is redundant, just do If booleanValue Then
Full code at bottom.
I've been getting an ArgumentException: "Illegal characters in path" whenever I attempt to save my text file in the program I've created.
My thoughts are that it has something to do with the directory path(path is chosen by user when prompted to open the file using an inputbox). My path on my computer being:
C:\Users\User\Desktop\HighScoreEditor
I've read tab characters can be the cause of this exception so my thoughts were maybe it's caused by the "\" in the directory path. I'm a 2nd year University Student so I may be completely wrong.
What I'm looking for is how to ignore this exception so that my file is saved, or a way to fix it so this exception does not occur.
My file is read from a directory path input by the user during an inputbox:
Dim message, title, defaultValue As String
Dim myValue As Object
Dim inFile As StreamReader
Dim strLine As String
' Set prompt.
message = "Enter a directory path to open your HighScore List."
' Set title.
title = "Which HighScore List should I open?"
defaultValue = "" ' Set default value.
' Display message, title, and default value.
myValue = InputBox(message, title, defaultValue)
' If user has clicked Cancel.
If myValue Is "" Then
Exit Sub
End If
Try
If File.Exists(myValue) = False Then
MessageBox.Show("Error: File/Directory Path """ & myValue & """ does not exist.")
ElseIf File.Exists(myValue) = True Then
inFile = File.OpenText(myValue)
Do While inFile.Peek <> -1
strLine = inFile.ReadLine()
txtScores.Text = txtScores.Text & vbCrLf & strLine
Loop
' Close the file.
inFile.Close()
End If
Catch ex As Exception
MessageBox.Show("Error: File/Directory Path """ & myValue & """ was found, however could not be opened." & vbCrLf & "" & vbCrLf & "Please make sure the list has a .txt file extension.")
End Try
Here is my code for my StreamWriter and save button:
Private Sub mnuFile_Save_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuFile_Save.Click
Dim outFile As StreamWriter
outFile = File.CreateText(txtScores.Text)
outFile.WriteLine(txtScores.Text)
outFile.Close()
End Sub
------FULL CODE BELOW------
Imports System.IO
Public Class frmHighScore_Editor
Dim strTxt As String = "Click File > Open to display your HighScore List Here."
Private Sub mnuFile_Exit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuFile_Exit.Click
' Terminates the program.
Me.Close()
End Sub
Private Sub mnuFile_Open_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuFile_Open.Click
Dim frmContinue As New frmContinue
frmContinue.ShowDialog()
Dim message, title, defaultValue As String
Dim myValue As Object
Dim inFile As StreamReader
Dim strLine As String
' Set prompt.
message = "Enter a directory path to open your HighScore List."
' Set title.
title = "Which HighScore List should I open?"
defaultValue = "" ' Set default value.
' Display message, title, and default value.
myValue = InputBox(message, title, defaultValue)
' If user has clicked Cancel.
If myValue Is "" Then
Exit Sub
End If
txtScores.Text = String.Empty
Try
If File.Exists(myValue) = False Then
txtScores.Text = strTxt
MessageBox.Show("Error: File/Directory Path """ & myValue & """ does not exist.")
ElseIf File.Exists(myValue) = True Then
txtScores.Text = String.Empty
If myValue.Contains("Blackjack.txt") Then
pbGame_Photo.Image = HighScores.My.Resources.Blackjack
lblGameName_Output.Text = "Blackjack"
ElseIf myValue.Contains("Mahjong.txt") Then
pbGame_Photo.Image = HighScores.My.Resources.Mahjong
lblGameName_Output.Text = "Mahjong"
ElseIf myValue.Contains("Minesweeper.txt") Then
pbGame_Photo.Image = HighScores.My.Resources.Minesweeper
lblGameName_Output.Text = "MineSweeper"
ElseIf myValue.Contains("Pinball.txt") Then
pbGame_Photo.Image = HighScores.My.Resources.Pinball
lblGameName_Output.Text = "Pinball"
ElseIf myValue.Contains("Solitaire.txt") Then
pbGame_Photo.Image = HighScores.My.Resources.Solitaire
lblGameName_Output.Text = "Solitaire"
Else
pbGame_Photo.Image = HighScores.My.Resources.Blank
lblGameName_Output.Text = "Your Game"
End If
inFile = File.OpenText(myValue)
Do While inFile.Peek <> -1
strLine = inFile.ReadLine()
Dim Res As String = ""
Dim Array(0) As Integer
For Each c As Char In strLine
If IsNumeric(c) Then
Res = Res & c
If CInt(Res) > Array(0) Then
Array(0) = CInt(Res)
End If
End If
Next
txtScores.Text = txtScores.Text & vbCrLf & strLine
lblScoreAchieved_Output.Text = Array(0)
Loop
' Close the file.
inFile.Close()
txtScores.Enabled = True
End If
Catch ex As Exception
txtScores.Text = strTxt
MessageBox.Show("Error: File/Directory Path """ & myValue & """ was found, however could not be opened." & vbCrLf & "" & vbCrLf & "Please make sure the list has a .txt file extension.")
End Try
End Sub
Private Sub frmHighScore_Editor_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
' Set the focus.
gbGameInfo.Focus()
pbGame_Photo.Image = HighScores.My.Resources.Blank
' Disable text box on load since it's empty anyways.
txtScores.Enabled = False
txtScores.Text = strTxt
End Sub
Private Sub mnuFile_Save_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuFile_Save.Click
Dim outFile As StreamWriter
outFile = File.CreateText(txtScores.Text)
outFile.WriteLine(txtScores.Text)
outFile.Close()
End Sub
End Class
------FULL CODE ABOVE------
myValue = InputBox(message, title, defaultValue)
That's a very poor way to ask for a filename. Use SaveFileDialog instead. Short from the intuitive dialog that any Windows user knows how to operate, it also automatically avoids that exception.
So I've finally got this to almost work but now every few times I test the process the form and the progressbar freeze. I'm also sure there are much more efficient ways of doing this so any constructive criticism would be greatly appreciated.
This is the coding for one page of a program that allows the user to click one button to download and install one application and then press the next button to download and install a different application:
Imports System.Net.WebRequestMethods
Public Class Software
'Open link in external browser
Public Sub HandleRequestNavigate(ByVal sender As Object, ByVal e As RequestNavigateEventArgs)
Process.Start(New ProcessStartInfo(e.Uri.AbsoluteUri))
e.Handled = True
End Sub
'Declarations
Shared progressamc As New Progress
Shared progresscti As New ProgressCTI
WithEvents startcti As New Process
WithEvents startamc As New Process
WithEvents startsfstb As New Process
WithEvents amcworker As New ComponentModel.BackgroundWorker
WithEvents ctiworker As New ComponentModel.BackgroundWorker
Dim ProgressBarAMC As Object = Progress.ProgressBar1
Dim blprgrsAMC As Object = Progress.blprgrs
Dim ProgressBarCTI As Object = progresscti.ProgressBar1
Dim blprgrsCTI As Object = progresscti.blprgrs
'FTP Values
Const host As String = "ftp://10.167.16.80/"
Const username As String = "anonymous"
Const password As String = ""
'AMC File Put/Get
Const localfileamc As String = "C:\AMC.exe"
Const Remotefileamc As String = "Bin/AMC.exe"
'CTI File Put/Get
Const localfilecti As String = "C:\CTI.exe"
Const Remotefilecti As String = "Bin/CTI.exe"
'On Init
Public Sub New()
InitializeComponent()
amcworker.WorkerReportsProgress = True
amcworker.WorkerSupportsCancellation = True
ctiworker.WorkerReportsProgress = True
ctiworker.WorkerSupportsCancellation = True
End Sub
'Install AMC Button
Private Sub ButtonAMC(sender As Object, e As RoutedEventArgs)
Dim butt1 As Button = DirectCast(sender, Button)
butt1.IsEnabled = False
Dispatcher.BeginInvoke(New Action(AddressOf progressamc_Show))
AddHandler Progress.Cancel_Click, AddressOf myProcessamc_Exited
amcworker.RunWorkerAsync()
End Sub
'Open Dialog
Private Sub progressamc_Show()
Try
progressamc.ShowDialog()
Catch ex As Exception
MessageBox.Show("An error has occurred during the process:" & vbCrLf & vbCrLf & ex.Message & vbCrLf & vbCrLf & "Please close the application and try again." _
& vbCrLf & "If you continue to encounter this error please Email")
End Try
End Sub
'FTP - Download
Private Sub ftpseshamc_DoWork(ByVal sender As System.Object, ByVal e As ComponentModel.DoWorkEventArgs) Handles amcworker.DoWork
Dim URI As String = host & Remotefileamc
Dim FTP As System.Net.FtpWebRequest = CType(System.Net.FtpWebRequest.Create(URI), System.Net.FtpWebRequest)
'Set the credentials
FTP.Credentials = New System.Net.NetworkCredential(username, password)
'FTP Options
FTP.KeepAlive = False
FTP.UseBinary = True
'Define the action as Download
FTP.Method = System.Net.WebRequestMethods.Ftp.DownloadFile
'Get the response to the Ftp request and the associated stream
Try
Dim response As System.Net.FtpWebResponse = CType(FTP.GetResponse, System.Net.FtpWebResponse)
Dim Length As Long = response.ContentLength
Dim StopWatch As New Stopwatch
Dim CurrentSpeed As Double = Nothing
Using responseStream As IO.Stream = response.GetResponseStream
'loop to read & write to file
Using fs As New IO.FileStream(localfileamc, IO.FileMode.Create)
Dim buffer(2047) As Byte
Dim read As Integer = 0
Dim count As Integer
Do
If amcworker.CancellationPending = True Then
e.Cancel = True
Return
End If
StopWatch.Start()
amcworker.ReportProgress(CShort(count / Length * 100 + 0.5))
read = responseStream.Read(buffer, 0, buffer.Length)
fs.Write(buffer, 0, read)
count += read
Loop Until read = 0
StopWatch.Stop()
responseStream.Close()
fs.Flush()
fs.Close()
End Using
responseStream.Close()
End Using
response.Close()
Catch ex As Exception
MessageBox.Show("An error has occurred during the process:" & vbCrLf & vbCrLf & ex.Message & vbCrLf & vbCrLf & "Please close the application and try again." _
& vbCrLf & "If you continue to encounter this error please Email")
myProcessamc_Exited()
End Try
Installamc()
End Sub
'Starts the installation
Sub Installamc()
startamc.StartInfo.FileName = "C:\AMC.exe"
startamc.EnableRaisingEvents = True
Try
startamc.Start()
Catch ex As Exception
MsgBox(ex.Message)
End Try
Dispatcher.Invoke(New Action(AddressOf Progressamc_Hide))
End Sub
'Hide Dialog during install
Private Sub Progressamc_Hide()
progressamc.Hide()
End Sub
'Report progress
Private Sub amcworker_ProgressChanged(ByVal sender As System.Object, ByVal e As ComponentModel.ProgressChangedEventArgs) Handles amcworker.ProgressChanged
ProgressBarAMC.value = e.ProgressPercentage
blprgrsAMC.Content = "Downloading: " & e.ProgressPercentage & "%"
End Sub
End Class
Again, any help would be greatly appreciated.
Edit: I've made the following edit to the code but I'm not entirely sure it's doing what I think it's doing. Basically what I intended is for the ReportProgress to only run once every 2047 bytes read.
'Get the response to the Ftp request and the associated stream
Try
Dim response As System.Net.FtpWebResponse = CType(FTP.GetResponse, System.Net.FtpWebResponse)
Dim Length As Long = response.ContentLength
Dim StopWatch As New Stopwatch
Dim CurrentSpeed As Double = Nothing
Using responseStream As IO.Stream = response.GetResponseStream
'loop to read & write to file
Using fs As New IO.FileStream(localfileamc, IO.FileMode.Create)
Dim buffer(2047) As Byte
Dim read As Integer = 0
Dim count As Integer
Dim chunk As Integer = Int(2047 / Length)
Dim cycle As Integer = chunk = count
Do
If amcworker.CancellationPending = True Then
e.Cancel = True
Return
End If
StopWatch.Start()
If cycle = True Then
amcworker.ReportProgress(CShort(count / Length * 100 + 0.5))
Else
End
End If
read = responseStream.Read(buffer, 0, buffer.Length)
fs.Write(buffer, 0, read)
count += read
Loop Until read = 0
StopWatch.Stop()
responseStream.Close()
fs.Flush()
fs.Close()
End Using
responseStream.Close()
End Using
response.Close()
Catch ex As Exception
MessageBox.Show("An error has occurred during the process:" & vbCrLf & vbCrLf & ex.Message & vbCrLf & vbCrLf & "Please close the application and try again." _
& vbCrLf & "If you continue to encounter this error please Email")
myProcessamc_Exited()
End Try
I didn't scrutinize the code carefully, but I don't see why you're using stopwatch, so I took out the references. I'm not sure what starting it multiple times inside the loop and ending it outside would do anyway.
The use of the word END in the second example will comletely end your app! Pretty sure that's what you want there.
Try this modification of your first code. The key is only updating if change is >= 5%:
Using fs As New IO.FileStream(localfileamc, IO.FileMode.Create)
Dim buffer(2047) As Byte
Dim read As Integer = 0
Dim count As Integer
dim LastPct as Short = -5
dim Pct as Short = 0
Do
If amcworker.CancellationPending = True Then
e.Cancel = True
Return
End If
Pct = CShort(count / Length * 100 + 0.5)
if Pct>= (LastPct + 5)
amcworker.ReportProgress(Pct)
LastPCT= Pct
EndIf
read = responseStream.Read(buffer, 0, buffer.Length)
fs.Write(buffer, 0, read)
count += read
Loop Until read = 0
amcworker.ReportProgress(100)
responseStream.Close()
fs.Flush()
fs.Close()
End Using
The process cannot access the file 'F:\copy back up\system\HRM 2-5-2013\HRM\HRM\lanbased.txt' because it is being used by another process.
This is my code in sub main
Public localhost As String
Public username As String
Public port As String
Public database As String
Public conn As New MySqlConnection
Public NAME1 As String = "F:\copy back up\system\HRM 2-5-2013\HRM\HRM\lanbased.txt"
Public Sub main()
Dim frm As New Form1
Dim frm1 As New create
If System.IO.File.Exists(NAME1) = True Then
Try
Dim objReader As New System.IO.StreamReader(NAME1)
localhost = objReader.ReadLine() & vbNewLine
username = objReader.ReadLine() & vbNewLine
port = objReader.ReadLine() & vbNewLine
database = objReader.ReadLine() & vbNewLine
conn.ConnectionString = "server=" & Trim(localhost) & ";user id=" & Trim(username) & "; password=" & Trim(port) & "; database=" & Trim(database) & ""
conn.Open()
Application.Run(New Form1())
Catch ex As Exception
MsgBox("Unable to connect to database", vbCritical)
Application.Run(New create())
End Try
End If
Exit Sub
End Sub
and this is my code in my form create.
How do I access the file when it is being used by another process?
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim FILE_NAME As String = "F:\copy back up\system\HRM 2-5-2013\HRM\HRM\lanbased.txt"
If TextBox1.Text = Nothing Or TextBox2.Text = Nothing Or TextBox3.Text = Nothing Or TextBox4.Text = Nothing Then
MsgBox("fill up mo pa ngot")
ElseIf System.IO.File.Exists(FILE_NAME) = True Then
Dim objWriter As New System.IO.StreamWriter(FILE_NAME)
objWriter.Write(TextBox1.Text + vbCrLf)
objWriter.Write(TextBox2.Text + vbCrLf)
objWriter.Write(TextBox3.Text + vbCrLf)
objWriter.Write(TextBox4.Text + vbCrLf)
objWriter.Close()
TextBox1.Clear()
TextBox2.Clear()
TextBox3.Clear()
TextBox4.Clear()
ElseIf conn.State = True Then
MsgBox("maka connect naka")
End If
End Sub
first you open your file for reading here :
Dim objReader As New System.IO.StreamReader(NAME1) //1st open
Second you call the form1 : Application.Run(New Form1())
in that Form you have : Dim objWriter As New System.IO.StreamWriter(FILE_NAME) //2nd open
But wait you didn't close your file so you can't open it 2nd time for writing.
So you need to close the file before calling create form 1 like objReader.close()
conn.Open()
objReader.close() <----- this one
Application.Run(New Form1())
Looks like you need to close your streamReader before opening the new form:
objReader.Close()
That will free the file.
I have a little code for saving an image from an URL in VB.NET but im not finding the location where it saves the image, i added a location string but i dont know how to use it in the code.
How do i change the location whre my code saves the image ( Imports System.Drawing
Public Class Form1)
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim MyImage As System.Drawing.Image
Dim URL As String = TextBox1.Text
Dim FileName As String, URLpieces As String()
Dim location As String = "C:/SaveIMGURL/"
URLpieces = Split(URL, "/")
FileName = URLpieces.GetValue(UBound(URLpieces))
MyImage = GetImage(URL)
MyImage.Save(FileName)
MyImage = Nothing
End Sub
Function GetImage(ByVal URL As String) As System.Drawing.Image
Dim Request As System.Net.HttpWebRequest
Dim Response As System.Net.HttpWebResponse
Request = System.Net.WebRequest.Create(URL)
Response = CType(Request.GetResponse, System.Net.WebResponse)
If Request.HaveResponse Then
If Response.StatusCode = Net.HttpStatusCode.OK Then
GetImage = System.Drawing.Image.FromStream(Response.GetResponseStream)
End If
End If
Try
Catch e As System.Net.WebException
MsgBox("A web exception has occured [" & URL & "]." & vbCrLf & " System returned: " & e.Message, MsgBoxStyle.Exclamation, "Error!")
Exit Try
Catch e As System.Net.ProtocolViolationException
MsgBox("A protocol violation has occured [" & URL & "]." & vbCrLf & " System returned: " & e.Message, MsgBoxStyle.Exclamation, "Error!")
Exit Try
Catch e As System.Net.Sockets.SocketException
MsgBox("Socket error [" & URL & "]." & vbCrLf & " System returned: " & e.Message, MsgBoxStyle.Exclamation, "Error!")
Exit Try
Catch e As System.IO.EndOfStreamException
MsgBox("An IO stream exception has occured. System returned: " & e.Message, MsgBoxStyle.Exclamation, "Error!")
Exit Try
Finally
End Try
End Function
End Class