CheckForDetailedUpdate throws "Cannot bind to deployment that is not installed" - vb.net

Question

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

Answer 1

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)"

Answer 2

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

Answer 3

"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

Answer 4

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