add automatic in-app-updater

This commit is contained in:
2023-08-26 21:40:15 +02:00
parent 0e9667ab59
commit 0776611de4
4 changed files with 120 additions and 5 deletions

View File

@@ -0,0 +1,70 @@
Imports System.IO
Imports System.Net
Imports System.Net.Http
Imports WebDav
Public Class AppUpdater
Private Const WEBDAV_URL As String = "https://cloud.pilzinsel64.de/public.php/webdav"
Private Const WEBDAV_KEY As String = "z4dGicDYmG2neG9"
Private Const DOWNLOAD_URL As String = "https://cloud.pilzinsel64.de/s/z4dGicDYmG2neG9/download"
Public Shared Async Function Check() As Task(Of Boolean)
Dim appFileName = Pilz.IO.Extensions.GetExecutablePath()
Dim hasUpdate As Boolean = False
Dim params As New WebDavClientParams With {
.BaseAddress = New Uri(WEBDAV_URL),
.Credentials = New NetworkCredential(WEBDAV_KEY, String.Empty)
}
Try
Using client As New WebDavClient(params)
Dim result = Await client.Propfind(String.Empty)
If result.IsSuccessful AndAlso result.Resources.Any Then
Dim resource = result.Resources(0)
Dim appModificationDate = File.GetLastWriteTimeUtc(appFileName)
Dim remoteModificationDate = resource.LastModifiedDate?.ToUniversalTime
If remoteModificationDate > appModificationDate Then
hasUpdate = True
End If
End If
End Using
Catch ex As Exception
End Try
Return hasUpdate
End Function
Public Shared Async Function Install() As Task
Dim client As New HttpClient
Dim tempFileName = Path.GetTempFileName
Dim appFileName = Pilz.IO.Extensions.GetExecutablePath()
Dim oldFileName = appFileName & ".old"
'Delete old file
Try
File.Delete(oldFileName)
Catch ex As Exception
End Try
'Download the new file
Using tempFileStream As New FileStream(tempFileName, FileMode.Create, FileAccess.ReadWrite)
Dim downloadStream As Stream = Nothing
Try
downloadStream = Await client.GetStreamAsync(DOWNLOAD_URL)
Await downloadStream.CopyToAsync(tempFileStream)
Catch
Finally
downloadStream?.Dispose()
End Try
End Using
'Replace current application file with new file
File.Move(appFileName, oldFileName, True)
File.Move(tempFileName, appFileName)
End Function
End Class

View File

@@ -2,6 +2,7 @@ Imports System.IO
Imports ModpackUpdater.My.Resources
Imports Telerik.WinControls
Imports Telerik.WinControls.UI
Public Class Form1
@@ -19,7 +20,7 @@ Public Class Form1
Return Not String.IsNullOrEmpty(GetMinecraftProfilePath)
End Function
Private Function GetMinecraftProfilePath() As string
Private Function GetMinecraftProfilePath() As String
Return RadTextBoxControl_MinecraftProfileFolder.Text.Trim
End Function
@@ -27,7 +28,7 @@ Public Class Form1
Return Not String.IsNullOrEmpty(GetUpdateconfigPath)
End Function
Private Function GetUpdateconfigPath() As string
Private Function GetUpdateconfigPath() As String
Return RadTextBoxControl_ModpackConfig.Text.Trim
End Function
@@ -43,7 +44,7 @@ Public Class Form1
End If
End Function
Private Sub SetStatus(statusText As string, image As Image)
Private Sub SetStatus(statusText As String, image As Image)
RadLabel_Status.Text = statusText
RadLabel_Status.Image = image
End Sub
@@ -53,7 +54,7 @@ Public Class Form1
RadLabel_Status.Image = Nothing
End Sub
Private Sub LoadMinecraftProfile(folderPath As string)
Private Sub LoadMinecraftProfile(folderPath As String)
RadTextBoxControl_MinecraftProfileFolder.Text = folderPath
If IsUpdateConfigLoaded() Then
@@ -63,7 +64,7 @@ Public Class Form1
End If
End Sub
Private Sub LoadUpdateConfigFile(filePath As string)
Private Sub LoadUpdateConfigFile(filePath As String)
RadTextBoxControl_ModpackConfig.Text = filePath
If IsUpdateConfigLoaded() Then
@@ -183,4 +184,12 @@ Public Class Form1
End If
End Sub
Private Async Sub Form1_Shown(sender As Object, e As EventArgs) Handles Me.Shown
If Await AppUpdater.Check AndAlso RadMessageBox.Show(LangRes.MsgBox_UpdateAvailable, LangRes.MsgBox_UpdateAvailable_Title, MessageBoxButtons.YesNo, RadMessageIcon.Info) = DialogResult.Yes Then
SetStatus(LangRes.StatusText_InstallingAppUpdate, MySymbols.icons8_software_installer_16px)
Enabled = False
Await AppUpdater.Install()
Application.Restart()
End If
End Sub
End Class

View File

@@ -64,6 +64,24 @@ Namespace My.Resources
End Set
End Property
'''<summary>
''' Sucht eine lokalisierte Zeichenfolge, die A new version of this program is available. If you confirm, the update will be installed automatically. It takes just a few seconds. Continue? ähnelt.
'''</summary>
Friend Shared ReadOnly Property MsgBox_UpdateAvailable() As String
Get
Return ResourceManager.GetString("MsgBox_UpdateAvailable", resourceCulture)
End Get
End Property
'''<summary>
''' Sucht eine lokalisierte Zeichenfolge, die New program version available ähnelt.
'''</summary>
Friend Shared ReadOnly Property MsgBox_UpdateAvailable_Title() As String
Get
Return ResourceManager.GetString("MsgBox_UpdateAvailable_Title", resourceCulture)
End Get
End Property
'''<summary>
''' Sucht eine lokalisierte Zeichenfolge, die Everything is right and up-to-date. ähnelt.
'''</summary>
@@ -109,6 +127,15 @@ Namespace My.Resources
End Get
End Property
'''<summary>
''' Sucht eine lokalisierte Zeichenfolge, die Downloading program update... ähnelt.
'''</summary>
Friend Shared ReadOnly Property StatusText_InstallingAppUpdate() As String
Get
Return ResourceManager.GetString("StatusText_InstallingAppUpdate", resourceCulture)
End Get
End Property
'''<summary>
''' Sucht eine lokalisierte Zeichenfolge, die Minecraft profile folder seems to be not valid. ähnelt.
'''</summary>

View File

@@ -117,6 +117,12 @@
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<data name="MsgBox_UpdateAvailable" xml:space="preserve">
<value>A new version of this program is available. If you confirm, the update will be installed automatically. It takes just a few seconds. Continue?</value>
</data>
<data name="MsgBox_UpdateAvailable_Title" xml:space="preserve">
<value>New program version available</value>
</data>
<data name="StatusTest_EverythingOk" xml:space="preserve">
<value>Everything is right and up-to-date.</value>
</data>
@@ -132,6 +138,9 @@
<data name="StatusText_Installing" xml:space="preserve">
<value>Installing...</value>
</data>
<data name="StatusText_InstallingAppUpdate" xml:space="preserve">
<value>Downloading program update...</value>
</data>
<data name="StatusText_MinecraftProfileWarning" xml:space="preserve">
<value>Minecraft profile folder seems to be not valid.</value>
</data>