I am making trial version of my vb .net project but it is not counting the days , date and time .
Can u please give me any suggestions to correct it. I am using the following code
Public Class Form1
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim intTime As Integer = 1
Dim dteLastStart, dteStartDate As Date
Dim blnFirstTime, blnEnabled As Boolean
Dim lngTimeLeft As Long
blnEnabled = True
If dteStartDate = Nothing Then
dteStartDate = Now
End If
My.Application.SaveMySettingsOnExit = True
If DateDiff(DateInterval.Day, dteLastStart, Now) < 0 Then
'First clock change
If intTime = 1 Then
MsgBox("FRED has detected that you have changed your system date to an earlier date" & vbCrLf & "As FRED has built-in security," & vbCrLf & "FRED will only run until the next intTime you change your system date", MsgBoxStyle.OkOnly Or MsgBoxStyle.Exclamation, "System Date Changed")
intTime = 2
ElseIf intTime = 2 Then
'Second clock change
blnEnabled = False
MsgBox("FRED has detected that you have changed your system date to an earlier date" & vbCrLf & "As this is the second warning, FRED will now be disabled", MsgBoxStyle.OkOnly Or MsgBoxStyle.Exclamation, "System Date Changed")
End If
'disables app
If blnEnabled = False Then
If MsgBox("FRED is disabled", MsgBoxStyle.OkOnly Or MsgBoxStyle.Information, "Disabled") = MsgBoxResult.Ok Then
For Each form As Form In My.Application.OpenForms
form.Close()
Next
End If
End If
End If
If DateDiff(DateInterval.Day, dteStartDate, Now) > 29 Then
blnEnabled = False
If blnEnabled = False Then
If MsgBox("FRED has reached the end of it's trial.", MsgBoxStyle.OkOnly Or MsgBoxStyle.Information, "Trial Ended") = MsgBoxResult.Ok Then
'Close all open forms
For Each form As Form In My.Application.OpenForms
form.Close()
Next
End If
End If
End If
dteLastStart = Now
If blnFirstTime = True Then
blnFirstTime = False
End If
'Saves variable settings
My.Settings.Save()
lngTimeLeft = 29 - (DateDiff(DateInterval.Day, dteStartDate, Now))
MsgBox("This is a 29-day trial version." & vbCrLf & "You have " & CStr(lngTimeLeft) & " days left.", MsgBoxStyle.OkOnly, "FRED Trial")
end sub
end class
Let's say your program called "MyProg" and you want user to try it for 7 days.
So, conceptually, you'll have entry in registry:
HKLM\SOFTWARE\MyProg
Each run of the software, you will have to check if it exists, if not, assuming it's a first run and you will create the entry and set value. If entry exists, you will retrieve value and compare to now.
No for coding, here is an example function that handles registry and returns false if date expired or true if still trial period:
Private Function HandleRegistry() As Boolean
Dim firstRunDate As Date
firstRunDate = My.Computer.Registry.GetValue("HKEY_LOCAL_MACHINE\SOFTWARE\MyProg", "FirstRun", Nothing)
If firstRunDate = Nothing Then
firstRunDate = Now
My.Computer.Registry.SetValue("HKEY_LOCAL_MACHINE\SOFTWARE\MyProg", "FirstRun", firstRunDate)
ElseIf (Now - firstRunDate).Days > 7 Then
Return False
End If
Return True
End Function
No all you have to do, is to call it and handle response:
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Dim result As Boolean = HandleRegistry()
If result = False Then 'something went wrong
MsgBox("Trial expired")
Else
MsgBox("Trial version")
End If
End Sub
Of course this is example only, so you get the idea, but practicality i would encode date and call registry name entry something else so it won't be user friendly. Also, remember the architecture issue so you know where it's written.
Hope that helps
Related
I am working on a text adventure game. The goal of this program is to display three options and a textbox. The user can select one of the options by entering the corresponding number into a text box, which then is supposed to navigate the user into the next area, where the user is presented with another 3 options.
The issue I am currently having is navigating through the area game areas.
Sub gameOver(ByVal DeathMessage)
lblTitle.Text = "Game Over!"
lblMain.Text = DeathMessage
End Sub
Sub pgMain()
lblMain.Text = $"Enter 1 to start the game{vbCrLf}Enter 2 to quit the game"
If aryInput(0) = "1" Then
pg1()
ElseIf aryInput(0) = "2" Then
Me.Close()
End If
End Sub
Private Sub btnSubmit_Click(sender As Object, e As EventArgs) Handles btnSubmit.Click
aryInput(0) = tbxInput.Text
End Sub
Sub pg1() ' User picks a starting option
lblTitle.Text = "You spot a secret magical lair do you"
lblMain.Text = $"1. Enter the lair through the front door{vbCrLf}2. Enter the lair through the back door{vbCrLf}3. Wait untill midnight to enter the lair."
If aryInput(0) = "1" Then
MsgBox("Front door") 'pg2()
ElseIf aryInput(0) = "2" Then
MsgBox("backdoor")
pg3()
ElseIf aryInput(0) = "3" Then
gameOver("You were mauled by wolves")
End If
End Sub
'Sub pg2() ' User entered through the front door.
' lblMain.Text = $"1. Go to the chest{vbCrLf}2. Go to the bookshelf{vbCr}3. Go to the cauldron"
' If tbxInput.Text = "1" Then
' pg5() ' They went to the chest
' ElseIf tbxInput.Text = "2" Then
' pg6() ' User went to the bookshelf
' ElseIf tbxInput.Text = "3" Then
' pg7() ' User went to the cauldron
' End If
'End Sub
Sub pg3()
tbxInput.Text = Nothing
lblTitle.Text = "You were splashed with a poison spell do you"
lblMain.Text = $"1. Cut off the infected part{vbCrLf}2. Drink a bucket of milk{vbCrLf}3. Inject yourself with some sort of medical syringe"
If tbxInput.Text = "1" Then
MsgBox("Infected Part") 'pg8()
ElseIf tbxInput.Text = "2" Then
MsgBox("Milk") 'pg9()
ElseIf tbxInput.Text = "3" Then
gameOver("You injected yourself with viper venom.")
End If
End Sub
As you can probably tell I am having issues with getting the content of the textbox to decide where the user will go next. I have tried using Input Boxes, and yes it works but they have a character limit and I would prefer figuring out a way to do this with a text box. I was also considering a way using key presses instead of a button click. Sorry for the beginner question, I am still learning my way around Visual Basic. Thank you in advance!
I like radio buttons better because it is easier to control user input. A user can put anything in a text box and you need to handle the possibility that it is not 1, 2, or 3.
Initially RadioButton3.Visible is set to False at design time. It becomes visible if the user selects to start the game.
We kick the whole thing off in Form.Load. I declared a Form level variable to keep track of what page we are on, PageNum.
I have only set properties in the pgX subs. All the action is in the submit button. The first thing is to find which radio button is selected. The GetSelectedRadioButton returns the selected button or Nothing. You have to pass Me (which refers to the Form, the class where the code is running) as the container. Often radio buttons are found in a GroupBox or other container control so this allows for that.
You will need to write the code for pg5, pg6, pg7, pg8, and pg9. Also add Case 5, Case 6, Case 7, Case 8, and Case 9 to the submit button.
Private PageNum As Integer
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
pgMain()
End Sub
Private Sub pgMain()
lblMain.Text = "Make a selection and click Submit"
RadioButton1.Text = "start the game"
RadioButton2.Text = "quit the game"
End Sub
Private Sub btnSubmit_Click(sender As Object, e As EventArgs) Handles btnSubmit.Click
Dim rb As RadioButton = GetSelectedRadioButton(Me)
If rb IsNot Nothing Then
Dim Name = rb.Name
Select Case PageNum
Case 0
If Name = "RadioButton1" Then
pg1()
ElseIf Name = "RadioButton2" Then
Close()
End If
Case 1
If Name = "RadioButton1" Then
MsgBox("Front door") '
pg2()
ElseIf Name = "RadioButton2" Then
MsgBox("backdoor")
pg3()
ElseIf Name = "RadioButton3" Then
gameOver("You were mauled by wolves")
End If
Case 2
If Name = "RadioButton1" Then
pg5() ' They went to the chest
ElseIf Name = "RadioButton2" Then
pg6() ' User went to the bookshelf
ElseIf Name = "RadioButton3" Then
pg7() ' User went to the cauldron
End If
Case 3
If Name = "RadioButton1" Then
MsgBox("Infected Part")
pg8()
ElseIf Name = "RadioButton2" Then
MsgBox("Milk")
pg9()
ElseIf Name = "RadioButton3" Then
gameOver("You injected yourself with viper venom.")
End If
End Select
Else
MessageBox.Show("Please make a selection.")
End If
End Sub
Public Function GetSelectedRadioButton(Container As Control) As RadioButton
Dim rb = Container.Controls.OfType(Of RadioButton)().FirstOrDefault(Function(r) r.Checked = True)
Return rb
End Function
Private Sub pg1() ' User picks a starting option
PageNum = 1
lblTitle.Text = "You spot a secret magical lair do you"
RadioButton1.Text = "Enter the lair through the front door"
RadioButton2.Text = "Enter the lair through the back door"
RadioButton3.Visible = True 'Set to False at design time
RadioButton3.Text = "Wait untill midnight to enter the lair."
End Sub
Private Sub pg2() ' User entered through the front door.
PageNum = 2
lblTitle.Text = "You see a chest, a bookself, and a cauldron"
RadioButton1.Text = "Go to the chest"
RadioButton2.Text = "Go to the bookshelf"
RadioButton3.Text = "Go to the cauldron"
End Sub
Private Sub pg3()
PageNum = 3
lblTitle.Text = "You were splashed with a poison spell do you"
RadioButton1.Text = "Cut off the infected part"
RadioButton2.Text = "Drink a bucket of milk"
RadioButton3.Text = "Inject yourself with some sort of medical syringe"
End Sub
Private Sub gameOver(DeathMessage As String)
lblTitle.Text = "Game Over!"
lblMain.Text = DeathMessage
RadioButton1.Visible = False
RadioButton2.Visible = False
RadioButton3.Visible = False
btnSubmit.Visible = False
End Sub
I have a 10 second timer checking for updates. I have tried putting "check for updates" in the timer routine. I tried "checking for updates" in a background worker . I have tried async "checking for updates". All throw "Cannot bind to deployment that is not installed". After that, I get a new exception, "Object reference not set to an instance of an object". The exception is not necessarily on the 1st check for updates. I have had it run for hours before throwing an exception. After that, it will no longer retrieve an update. If I can't fix the issue, I would like to clear the error. Every 10 seconds out of a hat. I write to a log and/or restart the computer on the main thread.
Private Sub tmrAppUpdate_Tick(sender As Object, e As EventArgs) Handles tmrAppUpdate.Tick
If bwAutoUpdates.IsBusy Then Return 'if updates busy...leave
bwAutoUpdates.RunWorkerAsync() 'check for updates
End Sub
''' <summary>check for and get automatic updates</summary>
Private Sub bwAutoUpdates_DoWork(sender As Object, e As DoWorkEventArgs) Handles bwAutoUpdates.DoWork
e.Result = {"ok", ""} 'default message
Try
Dim updateCheck = ApplicationDeployment.CurrentDeployment 'updates
Dim info = updateCheck.CheckForDetailedUpdate() 'get update info
If info.UpdateAvailable Then 'if updates available...
updateCheck.Update() 'download updates
e.Result = {"restart", "Automatic Update ReStart: "} 'error, error message
End If '
Catch ex As InvalidOperationException 'error
e.Result = {"err", "bw ioe: " & ex.Message} 'error, error message
Catch ex As DeploymentDownloadException 'error
e.Result = {"err", "bw dde: " & ex.Message} 'error, error message
Catch ex As InvalidDeploymentException 'error
e.Result = {"err", "bw ide: " & ex.Message} 'error, error message
Catch ex As TrustNotGrantedException 'error
e.Result = {"err", "bw tnge: " & ex.Message} 'error, error message
Catch ex As Exception 'error
e.Result = {"err", "bw ax: " & ex.Message} 'error, error message
End Try '
End Sub
Private Sub bwAutoUpdates_RunWorkerCompleted(sender As Object, e As RunWorkerCompletedEventArgs) Handles bwAutoUpdates.RunWorkerCompleted
Dim result = CType(e.Result, Array).OfType(Of String)
If result(1).Length > 0 Then writeLog(result(1)) 'write to log!
Select Case result(0) 'what are we going to do?
Case "ok" : Return 'everything ok
Case "restart" : Application.Restart() 'restart
Case "err" 'errors
End Select
End Sub
The new code is crashing. In poking around, I discovered that this problem has been lurking for 10 years. I don't know why everyone isn't aware of it.
Microsoft Discussion
"A privilege that the service requires to function properly does not exist in the service account configuration. You may use the Services Microsoft Management Console (MMC) snap-in (services.msc) and the Local Security Settings MMC snap-in (secpol.msc) to view the service configuration and the account configuration. (Exception from HRESULT: 0x80070511)"
For the past couple of weeks I have fooled with automatic updates. It has bugs and fails if your app checks for updates often. I have included a link to the full project. You can download it, run it for a couple of days and watch it fail (usually within a couple of hours). When it fails, there seems to be no way to clear the error without a restarting. I have seen reports of this bug going back 10 years. If you find a fix, please let me know. Thanks Sandy
vb.net AutomaticUpdates
"Improved solution"
Imports System.ComponentModel
Imports System.Deployment.Application
Imports System.Deployment.Application.ApplicationDeployment
Public Class frmMain
Private lngUpdateSize As Long = 0
Dim WithEvents ad As ApplicationDeployment
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
lblRev.Text = getRev()
End Sub
Private Sub UpdateApplication()
If ApplicationDeployment.IsNetworkDeployed Then '
ad = ApplicationDeployment.CurrentDeployment '
ad.CheckForUpdateAsync() 'any updates...anyone?
End If
End Sub
Private Sub adUpdate_CheckForUpdateProgressChanged(ByVal sender As Object, ByVal e As
DeploymentProgressChangedEventArgs) Handles ad.CheckForUpdateProgressChanged
Const fmt = "{0:F1}K of {1:F1}K downloaded." 'string format
txtUpdateStatus.Text = String.Format(fmt, e.BytesCompleted / 1024, e.BytesTotal /
1024)
End Sub
Private Sub adUpdate_CheckForUpdateCompleted(ByVal sender As Object, ByVal e As
CheckForUpdateCompletedEventArgs) Handles ad.CheckForUpdateCompleted
If e.Cancelled Then 'if update canceled
lblMsg.Text = "The update was cancelled." 'display message
Return 'leave
ElseIf e.Error IsNot Nothing Then 'if there was an error
MessageBox.Show("ERROR") 'display message
Return 'leave
End If '
If e.UpdateAvailable Then 'if updates available
lngUpdateSize = e.UpdateSizeBytes 'get download size
Dim msg = "" 'holder for message
If Not e.IsUpdateRequired Then 'update flag set
msg = "Optional update, Installing now!" 'required message
Else 'optional update
msg = "Mandatory update, Installing now!" 'optional message
End If
lblMsg.Text = msg 'display message
lblMsg.Refresh() 'make we see message
Threading.Thread.Sleep(2000) 'give chance to see message
BeginUpdate() '
End If
End Sub
Private Sub BeginUpdate()
ad = ApplicationDeployment.CurrentDeployment '
ad.UpdateAsync() 'we have them...install em
now!!!
End Sub
Private Sub adUpdate_UpdateProgressChanged(ByVal sender As Object, ByVal e As
DeploymentProgressChangedEventArgs) Handles ad.UpdateProgressChanged
Const fmt = "{0:F1}K out of {1:F1}K downloaded - {2:F1}% complete"
Dim strProgress = String.Format(fmt, e.BytesCompleted / 1024, e.BytesTotal / 1024,
e.ProgressPercentage)
txtUpdateStatus.Text = strProgress
End Sub
Private Sub adUpdate_UpdateCompleted(ByVal sender As Object, ByVal e As
AsyncCompletedEventArgs) Handles ad.UpdateCompleted
If e.Cancelled Then 'if update canceled
lblMsg.Text = "The update was cancelled." 'display message
Return 'leave
ElseIf e.Error IsNot Nothing Then 'if there was an error
MessageBox.Show("ERROR") 'display message
Return 'leave
End If '
lblMsg.Text = "App finished updating, Restarting now!" 'display message
lblMsg.Refresh() 'make sure displayed
Threading.Thread.Sleep(2000) 'chance to see the message
Application.Restart() 'kill app and restart
End Sub
Private Sub tmrUpdate_Tick(sender As Object, e As EventArgs) Handles tmrUpdate.Tick
UpdateApplication() 'time to check for updates
End Sub
Function getRev() As String
If IsDebug() Then Return "Debug Mode" 'if debug...return
Return CurrentDeployment.CurrentVersion.ToString 'revision
End Function
Function IsDebug() As Boolean
Return Debugger.IsAttached 'return debug mode
End Function
End Class
I created a solution that might help. Basically I look at the modified date of the posted ".application" file. if the date changes, then updates pending. This example is not ftp or http, local only. It prevents CheckForUpdateAsync() from getting hammered (from what I have read is the cause of the problem). Hopes this helps...Sandy
Private Sub UpdateApplication()
If IsNetworkDeployed = False Then Return 'if not deployed...leave
Dim fName = CurrentDeployment.UpdateLocation.ToString 'full deployment path
fName = Replace(fName, "file:", Nothing) 'remove
Dim modD = CStr(File.GetLastWriteTime(fName)) 'get file modified
If modD = My.Settings.fileModified Then Return 'if files match...leave
My.Settings.fileModified = modD 'save modified date
ad = CurrentDeployment 'get current deployment
ad.CheckForUpdateAsync() 'any updates...anyone?
writeLog("check for updates") 'log it!
End Sub
I have a thread which is executing a sub and within a sub I am updating the textbox during a "Do while" loop is in progress. I then created a cancel button to abort the thread.
When the button is clicked then the thread is aborted but the textbox (Status_Txtbox.Text) doesn't get updated with the message "Parsing is terminated". I tried to do the debug and I see the code is executed perfectly and if condition for thread.isalive satisfies but not sure why the textbox doesn't get updated with the message.
Any idea how to update the textbox once thread is aborted ?
Dim thrd1 As Thread
Private Sub Parse_Btn_2G_Click(sender As Object, e As RoutedEventArgs) Handles Parse_Btn_2G.Click
Parse_Btn_2G.IsEnabled = False
Scan_Btn_2G.IsEnabled = False
cancel_Btn_2G.IsEnabled = True
Dim start As DateTime = DateTime.Now
Dim elapsedtime As Double
Dim action As Action
thrd1 = New Thread(Sub()
ButtonClickWork.DoWork()
action = Sub()
Status_Txtbox.Text = "Parsing Data, Please wait..."
End Sub
Me.Dispatcher.Invoke(action)
End Sub)
thrd1.Start()
elapsedtime = (DateTime.Now.Subtract(start).TotalSeconds) / 60
elapsedtime = Math.Round(elapsedtime, 2)
Status_Txtbox.Text = " Managed Objects in XML, total time elapsed is" & elapsedtime
End Sub
Private Sub Cancel_Btn_2G_Click(sender As Object, e As RoutedEventArgs) Handles cancel_Btn_2G.Click
Try
If cancel_Btn_2G.IsEnabled = True Then
If MsgBox("Do you really want to exit Parsing?", vbYesNo) = MsgBoxResult.Yes Then
Parse_Btn_2G.IsEnabled = True
Scan_Btn_2G.IsEnabled = True
cancel_Btn_2G.IsEnabled = False
thrd1.Abort()
thrd1.Join()
If thrd1.IsAlive = False Then
Status_Txtbox.Text = "Parsing is terminated"
End If
End If
End If
Catch ex As ThreadAbortException
Status_Txtbox.Text = "Parsing is terminated"
End Try
End Sub
I have multiple files to upload (to FTP server) using this code:
Private Sub UploadFile(ByVal local As String)
If wc.IsBusy = True Then Throw New Exception("An upload is already ongoing!")
wc.Credentials = New NetworkCredential(usr.ToString, pass.ToString) 'Set the credentials.
'total_dl_size = GetDownloadSize(url) 'Get the size of the current file.
Try
Dim FileName As String = Path.GetFileName(local) 'Get the current file's name.
AppendWarning("Uploading " & FileName & "... ") 'Download notice.
wc.UploadFileAsync(New Uri(info_srv & local), Path.Combine(mc_dir, local)) 'Download the file to the desktop (use your own path here).
Catch ex As Exception
AppendWarning("-ERR: Could not download file: " & local & ControlChars.NewLine)
End Try
End Sub
Private Sub AppendWarning(ByVal Text As String)
If tb_warnings.InvokeRequired Then
tb_warnings.Invoke(Sub() tb_warnings.AppendText(Text))
Else
tb_warnings.AppendText(Text)
End If
End Sub
Private Sub wc_UploadProgressChanged(sender As Object, e As System.Net.UploadProgressChangedEventArgs) Handles wc.UploadProgressChanged
total_ul = e.BytesSent
Dim Progress As Integer = CType(Math.Round((baseline + total_ul) * 100) / total_ul_size, Integer)
If ProgressBar1.InvokeRequired Then
ProgressBar1.Invoke(Sub()
If Progress > 100 Then Progress = 100
If Progress < 0 Then Progress = 0
ProgressBar1.Value = Progress
End Sub)
Else
If Progress > 100 Then Progress = 100
If Progress < 0 Then Progress = 0
ProgressBar1.Value = Progress
End If
If lbl_progress.InvokeRequired Then
lbl_progress.Invoke(Sub() lbl_progress.Text = ((total_ul + baseline) / 1024).ToString("N0") & " KB / " & (total_ul_size / 1024).ToString("N0") & " KB")
Else
lbl_progress.Text = ((total_ul + baseline) / 1024).ToString("N0") & " KB / " & (total_ul_size / 1024).ToString("N0") & " KB | " & Progress.ToString & "%"
End If
End Sub
Private Sub wc_uploadFileCompleted(sender As Object, e As System.ComponentModel.AsyncCompletedEventArgs) Handles wc.UploadDataCompleted
If e.Cancelled Then
MessageBox.Show(e.Cancelled)
ElseIf Not e.Error Is Nothing Then
MessageBox.Show(e.Error.Message)
Else
If files.Count > 0 Then
AppendWarning("Upload Complete!" & ControlChars.NewLine)
baseline = baseline + total_ul
Dim file As String = files.Dequeue()
MsgBox(file)
UploadFile(file) 'Download the next file.
Else
AppendWarning("All Uploads Finished!" & ControlChars.NewLine)
End If
End If
However, using my two test files, it always stops at what would otherwise be the end of the first file I've given it, and doesn't go onto the second one.
However, I have an FTP client connected to this same server, and when I refresh I can see (at least for the first file) the data is being properly uploaded.
Any suggestions as to what's going wrong here?
Edit, log: http://pastebin.com/kqG28NGH
Thank you for any assistance!
This works for me...I tried to mimic what I think is in your form. I tested with a queue of 8 files ranging from 150K to 400K each. I couldn't quite work out what you were trying to do with the progress bar. Mine fills for each file and resets for the next, finishing empty with the last call to DoUpload where there are no more files. Hopefully, this will help.
Imports System.IO
Imports System.Net
Public Class Form1
Const info_srv As String = "ftp://example.com/SomeFolder/"
Const usr As String = ""
Const pass As String = ""
Const mc_dir As String = "D:\Source\Folder"
Private WithEvents wc As New Net.WebClient
' Contains file names only, no paths
Private Files As New Queue(Of String)
Private Sub Button1_Click(sender As Object, e As EventArgs) _
Handles Button1.Click
wc.Credentials = New NetworkCredential(usr, pass)
' Put the work in a task so UI is responsive
Task.Run(Sub() DoUpload())
End Sub
Private Sub DoUpload()
ShowProgress("", 0)
If Files.Count > 0 Then
Dim local As String = Files.Dequeue
Dim FileName As String = Path.Combine(mc_dir, local)
AppendWarning("Uploading " & FileName & "... ")
Try
wc.UploadFileAsync(New Uri(info_srv & local), FileName)
Catch ex As Exception
AppendWarning("-ERR: Could not upload file: " & local & Environment.NewLine)
End Try
Else
AppendWarning("All Uploads Finished!" & Environment.NewLine)
End If
End Sub
Private Sub wc_UploadProgressChanged(sender As Object, e As UploadProgressChangedEventArgs) _
Handles wc.UploadProgressChanged
' Do not use e.ProgressPercentage - it's inaccurate by half by design per Microsoft
With String.Format("{0} KB / {1} KB", Int(e.BytesSent / 1024).ToString("N0"), Int(e.TotalBytesToSend / 1024).ToString("N0"))
ShowProgress(.ToString, Int(e.BytesSent / e.TotalBytesToSend * 100))
End With
End Sub
Private Sub wc_UploadFileCompleted(sender As Object, e As UploadFileCompletedEventArgs) _
Handles wc.UploadFileCompleted
Select Case True
Case e.Cancelled
MessageBox.Show("Cancelled")
Case e.Error IsNot Nothing
MessageBox.Show(e.Error.Message)
Case Else
AppendWarning("Upload Complete!" & Environment.NewLine)
' I needed this just so I could see it work, otherwise too fast
Threading.Thread.Sleep(500)
DoUpload()
End Select
End Sub
Private Sub AppendWarning(ByVal Text As String)
If Me.InvokeRequired Then
Me.Invoke(Sub() AppendWarning(Text))
Else
tb_warnings.AppendText(Text)
End If
End Sub
Private Sub ShowProgress(LabelText As String, Progress As Integer)
If Me.InvokeRequired Then
Me.Invoke(Sub() ShowProgress(LabelText, Progress))
Else
Me.lbl_progress.Text = LabelText
Me.lbl_progress.Refresh()
Me.ProgressBar1.Value = Progress
Me.ProgressBar1.Refresh()
End If
End Sub
End Class
For posterity:
Check your network trace settings in the VB config. I used a really verbose catch-all config I found to do the trace, but it seems the overhead was killing the upload. I've since found a much leaner focus-on-ftp set of xml to modify this and the files now upload properly. Thank you everyone!
I'm trying to notify users there has been a change to a file, by making a picturebox turn lime when the date in the application's settings is not equal to the LastWriteTime of a file. However, when i run the program and the two are equal (to my knowledge) it still says they are not equal. I've added a textbox in order to visualize it, but I don't know what I'm doing wrong...
My code:
fsw_wervelSTX_file = My.Computer.FileSystem.GetFileInfo("G:\divi\RATH\Applicaties\RSM\Program\Settings\IGART\WervelSTX\log_wervelSTX.txt")
If Not My.Settings.fsw_wevelSTX_lastwrite = fsw_wervelSTX_file.LastWriteTime Then
PictureBox_wervelSTX.BackColor = Color.Lime
MsgBox("Time in My.Settings: " & My.Settings.fsw_wevelSTX_lastwrite & " LastWriteTime: " & fsw_wervelSTX_file.LastWriteTime, MsgBoxStyle.Information)
Else
PictureBox_wervelSTX.BackColor = Color.Maroon
MsgBox("It is the same", MsgBoxStyle.Information)
End If
There's a screenshot of the MsgBox in the link:
MsgBox
The LastWriteTime is stored to My.Settings when the user clicks the button to open the specified file:
Code:
Private Sub Button11_Click(sender As System.Object, e As System.EventArgs) Handles Button11.Click
Try
Process.Start("G:\divi\RATH\Applicaties\RSM\Program\Settings\IGART\WervelSTX\log_wervelSTX.txt")
PictureBox_wervelSTX.BackColor = Color.Maroon
fsw_wervelSTX_file = My.Computer.FileSystem.GetFileInfo("G:\divi\RATH\Applicaties\RSM\Program\Settings\IGART\WervelSTX\log_wervelSTX.txt")
MsgBox(fsw_wervelSTX_file.LastWriteTime, MsgBoxStyle.Information)
My.Settings.fsw_wevelSTX_lastwrite = fsw_wervelSTX_file.LastWriteTime
Catch ex As Exception
MessageBox.Show("Error opening file: " & ex.Message)
End Try
End Sub
Thanks in advance.
Going from the code you posted I guess it's a serialization thing. The datetime is probably stored in your settings as something like 2016-01-06 12:08:11 (aside the actual date formatting) whereas the actual datetime probably has more/better 'resolution' and contains something like 2016-01-06 12:08:11.123. I'd suggest one of:
Storing it in a specific (specified) format and make sure you compare no more than the actual stored 'resolution'
Storing the value as ticks or some other specific long/integer value (e.g. UNIX timestamp for example)
Allow for some 'margin' when comparing
Which is best is up to you and the requirements / usecases.
There's all sorts of weird things with file datetimes like Why does the timestamp of a file increase by up to 2 seconds when I copy it to a USB thumb drive? but my best guess currently is that you're just comparing two slightly different values.
Added to load code:
Dim timecompare As Date
Private Sub IGART_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
fsw_wervelSTX_file = My.Computer.FileSystem.GetFileInfo("G:\divi\RATH\Applicaties\RSM\Program\Settings\IGART\WervelSTX\log_wervelSTX.txt")
timecompare = fsw_wervelSTX_file.LastWriteTime.ToString("yyyy-MM-dd HH:mm:ss")
If Not My.Settings.fsw_wevelSTX_lastwrite = timecompare Then
PictureBox_wervelSTX.BackColor = Color.Lime
MsgBox("Time in My.Settings: " & My.Settings.fsw_wevelSTX_lastwrite & " LastWriteTime: " & fsw_wervelSTX_file.LastWriteTime, MsgBoxStyle.Information)
Else
PictureBox_wervelSTX.BackColor = Color.Maroon
MsgBox("It is the same", MsgBoxStyle.Information)
End If
Added to button code:
Dim time As Date
Private Sub Button11_Click(sender As System.Object, e As System.EventArgs) Handles Button11.Click
Try
Process.Start("G:\divi\RATH\Applicaties\RSM\Program\Settings\IGART\WervelSTX\log_wervelSTX.txt")
PictureBox_wervelSTX.BackColor = Color.Maroon
fsw_wervelSTX_file = My.Computer.FileSystem.GetFileInfo("G:\divi\RATH\Applicaties\RSM\Program\Settings\IGART\WervelSTX\log_wervelSTX.txt")
MsgBox(fsw_wervelSTX_file.LastWriteTime, MsgBoxStyle.Information)
My.Settings.fsw_wevelSTX_lastwrite = fsw_wervelSTX_file.LastWriteTime.ToString("yyyy-MM-dd HH:mm:ss")
Catch ex As Exception
MessageBox.Show("Error opening file: " & ex.Message)
End Try
End Sub