Class App Inherits Application

Const kEditClear = "&Löschen"

Const kFileQuit = "Beenden"

Const kFileQuitShortcut = ""

EventHandler Sub Open() ' RegisterPlugins 'const url = "https://www.monkeybreadsoftware.de/UpdaterTest/appcast-redirect-test.xml" const url = "https://www.monkeybreadsoftware.de/UpdaterTest/appcast.xml" UpdaterEngine.Init url End EventHandler

End Class

Class MainWindow Inherits Window

End Class

MenuBar MenuBar1

MenuItem FileMenu = "&Ablage"

MenuItem FileQuit = "#App.kFileQuit"

MenuItem EditMenu = "&Bearbeiten"

MenuItem EditUndo = "&Rückgängig"

MenuItem UntitledMenu1 = "-"

MenuItem EditCut = "&Ausschneiden"

MenuItem EditCopy = "&Kopieren"

MenuItem EditPaste = "&Einfügen"

MenuItem EditClear = "#App.kEditClear"

MenuItem UntitledMenu0 = "-"

MenuItem EditSelectAll = "&Alles auswählen"

End MenuBar

Module UpdaterEngine

ComputedProperty Protected LastUpdateVersion As string

Sub Set() SavePrefValue "LastUpdateVersion", Value End Set

Sub Get() return LoadPrefValue("LastUpdateVersion") End Get

End ComputedProperty

ComputedProperty Private SecondLaunchFlag As Boolean

Sub Set() if value then SavePrefValue "SecondLaunchFlag", "true" else SavePrefValue "SecondLaunchFlag", "false" end if End Set

Sub Get() // if there is a value set, we are on the second run dim s as string = LoadPrefValue("SecondLaunchFlag") Return s="true" End Get

End ComputedProperty

ComputedProperty automaticallyCheckForUpdates As Boolean

Sub Set() #if TargetMachO dim updater as SUUpdaterMBS = updaterRef if updater<>nil then updater.automaticallyChecksForUpdates = value end if #endif if value then SavePrefValue "automaticallyChecksForUpdates", "true" else SavePrefValue "automaticallyChecksForUpdates", "false" end if End Set

Sub Get() #if TargetMachO dim updater as SUUpdaterMBS = updaterRef if updater<>nil then Return updater.automaticallyChecksForUpdates end if #endif Return LoadPrefValue("automaticallyChecksForUpdates")<>"false" // if not set, it'll be true End Get

End ComputedProperty

Const UseCURL = true

Const kCheckSumNodeName = "MD5Win"

Const kFailedToFindUpdate = "An error occurred in retrieving update information. Please try again later."

Const kLanguage = "?"

Const kLengthNodeName = "lengthWin"

Const kNoInternetConnection = "No Internet connection available."

Const kURLNodeName = "urlWin"

Const kYouhavethecurrentversion = "You have the current version of %."

Protected Sub CURLConfigure(c as Variant) #If UseCURL dim curl as CURLSMBS = c // configure curl here: curl.OptionVerbose = true curl.OptionFollowLocation = true curl.OptionFreshConnect = true curl.OptionMaxRedirs = 3 curl.OptionConnectionTimeout = 10 #Else #Pragma unused c #endif End Sub

Protected Sub CURLMultiTimerAction(t as timer) #Pragma Unused t #if UseCURL then dim multi as CURLSMultiMBS = CURLMulti if multi <> nil then multi.Perform end if #endif End Sub

Protected Sub CURLRun(c as Variant) // schedule CURL object #if UseCURL then dim curl as CURLSMBS = c dim multi as CURLSMultiMBS = CURLMulti if multi = nil then // initialize multi = new CURLSMultiMBS CurlMultiTimer = new timer AddHandler CurlMultiTimer.Action, AddressOf CurlMultiTimerAction CurlMultiTimer.Period = 20 CurlMultiTimer.Mode = 2 // store reference for later CURLMulti = multi end if // schedule transfer if not multi.AddCURL(curl) then Break // trouble? end if #Else #Pragma unused c #endif End Sub

Protected Sub CURLSearchUpdate(updatesocket as UpdateURLConnection) #Pragma unused updatesocket #If UseCURL Then // query update via CURL dim UpdateCURL as new CURLSMBS UpdateCURL.OptionURL = URL UpdateCURL.CollectOutputData = true UpdateCURL.CollectDebugData = true UpdateCURL.CollectHeaderData = true AddHandler UpdateCURL.Finished, AddressOf CURLSearchUpdateFinished // copy proxy setting, or set yourself here: Dim httpSock As New HTTPSocket If httpSock.HTTPProxyAddress <> "" Then If httpSock.HTTPProxyPort > 0 Then UpdateCURL.OptionProxy = httpSock.HTTPProxyAddress+":"+Str(httpSock.HTTPProxyPort) else UpdateCURL.OptionProxy = httpSock.HTTPProxyAddress end if end if CURLConfigure UpdateCURL CURLRun UpdateCURL CURLForSearchUpdate = UpdateCURL #EndIf End Sub

Protected Sub CURLSearchUpdateFinished(c as object, ResultCode as integer) #if UseCURL then dim curl as CURLSMBS = CURLSMBS(c) CURLForSearchUpdate = nil dim h as integer = curl.GetInfoResponseCode if ResultCode <> 0 or h <> 200 then // problem? dim DebugMessages as string = curl.DebugData // fix encoding if none is known if DebugMessages.Encoding = nil then if encodings.UTF8.IsValidData(DebugMessages) then DebugMessages = DefineEncoding(DebugMessages, encodings.UTF8) else DebugMessages = DefineEncoding(DebugMessages, encodings.ISOLatin1) end if end if DebugMessages = ReplaceLineEndings(DebugMessages, EndOfLine) // write log file try dim f as FolderItem = SpecialFolder.Preferences.Child("Updater.log") dim t as TextOutputStream = TextOutputStream.Create(f) t.Write DebugMessages catch io as IOException // ignore write error end try break // check debug messages Return end if // normal okay UpdaterEngine.GotXML curl.OutputData #Else #Pragma unused c #Pragma unused ResultCode #EndIf End Sub

Protected Sub CheckForUpdates() // Call for manual update search #if TargetMachO then dim updater as SUUpdaterMBS = updaterRef if updater <> Nil then // ask Sparkle to check for updates updater.checkForUpdates Return end if #endif // search for updates with our own engine if TestWindowsOnMac or TargetWin32 then SearchUpdate true end if End Sub

Private Sub CheckUpdateMac() // Loads sparkle framework for Mac and checks for updates in background #If TargetMachO Then // download Sparkle from their website: // https://sparkle-project.org // Place Sparkle Framework in the MacOS folder dim ExecutableFile as FolderItem = app.ExecutableFile dim MacOSFolder as FolderItem = ExecutableFile.Parent dim ContentsFolder as FolderItem = MacOSFolder.Parent dim FrameworksFolder as FolderItem = ContentsFolder.Child("Frameworks") Dim SparkleFramework As FolderItem = FrameworksFolder.Child("Sparkle.framework") if SparkleFramework <> Nil and SparkleFramework.Exists then if SUUpdaterMBS.LoadFramework(SparkleFramework) then // We loaded the Sparkle Framework dim Updater as new SUUpdaterMBS updaterRef = Updater if not DebugBuild then // updater can't work well in IDE without plist keys Updater.automaticallyDownloadsUpdates = true Updater.automaticallyChecksForUpdates = true if updater.automaticallyChecksForUpdates then Updater.checkForUpdatesInBackground end if end if end if end if #endif Exception n as runtimeexception // ignore all exceptions here End Sub

Protected Sub DisplayError(s as string) MsgBox kFailedToFindUpdate+EndOfLine+EndOfLine+s End Sub

Private Function FindChild(x as XmlNode, name as string) As XmlNode // Finds a child node in an xml node with the given name dim c as integer = x.ChildCount-1 for i as integer = 0 to c dim n as XmlNode = x.Child(i) if n <> Nil and n.LocalName = name then Return n end if next End Function

Private Function FindDescriptionURL(x as XmlNode) As string // Finds a child node in an xml node with the given name dim FirstURL as string dim c as integer = x.ChildCount-1 for i as integer = 0 to c dim n as XmlNode = x.Child(i) if n <> Nil and n.LocalName = "releaseNotesLink" then dim a as string = n.GetAttribute("xml:lang") if len(a)=0 then Return GetTextChild(n) else if a = kLanguage then Return GetTextChild(n) elseif len(FirstURL)=0 then // if the language is not availble on the server, we use the first one in list. FirstURL = GetTextChild(n) end if end if end if next End Function

Private Function FindDomainName(url as string) As string // Returns domain name of a given URL // e.g. https://www.macsw.de/something gives www.macsw.de dim p1 as integer = instr(url, "//") if p1>0 then dim p2 as integer = instr(p1+2, url, "/") if p2 = 0 then return mid(url, p1+2) else Return mid(url, p1+2, p2-p1-2) end if end if End Function

Private Sub FindProxyInNetworkService(sock as HTTPSecureSocket, dico as CFObjectMBS, s as SystemConfigurationMBS, p as SCPreferencesMBS) // Internal method to find the proxy settings from Mac OS X SystemConfiguration database in a given service if dico isa CFDictionaryMBS then dim cd as CFDictionaryMBS=CFDictionaryMBS(dico) // get the link path dim o as CFObjectMBS=cd.Value(s.kSCResvLink) if o isa CFStringMBS then dim cs as CFStringMBS=CFStringMBS(o) // search the Network Services linked cd=p.GetPathValue(cs) // get its proxy values o=cd.Value(s.kSCEntNetProxies) if o isa CFDictionaryMBS then cd=CFDictionaryMBS(o) dim HTTPEnable as Boolean // Check HTTPEnable: o=cd.Value(s.kSCPropNetProxiesHTTPEnable) if o isa CFBooleanMBS then dim b as CFBooleanMBS=CFBooleanMBS(o) HTTPEnable = b.Value end if // for unknown reason it is a CFNumber for the proxy settings!? if o isa CFNumberMBS then dim n as CFNumberMBS=CFNumberMBS(o) HTTPEnable = n.integerValue <> 0 end if if HTTPEnable then dim HTTPPort as integer o=cd.Value(s.kSCPropNetProxiesHTTPPort) if o isa CFNumberMBS then dim b as CFNumberMBS = CFNumberMBS(o) HTTPPort=b.integerValue end if dim HTTPProxy as string o=cd.Value(s.kSCPropNetProxiesHTTPProxy) if o isa CFStringMBS then dim b as CFStringMBS=CFStringMBS(o) HTTPProxy=b.Str end if if len(HTTPProxy)>0 then sock.HTTPProxyAddress = HTTPProxy end if if HTTPPort>0 then sock.HTTPProxyPort = HTTPPort end if end if end if end if end if End Sub

Private Function GetTextChild(x as XmlNode) As string dim c as integer = x.ChildCount-1 for i as integer = 0 to c dim n as XmlNode = x.Child(i) if n isa XmlTextNode then Return n.Value end if next End Function

Protected Function GetUpdater() As Variant // updater is stored here in a variant to avoid linking in the Cocoa plugins on Windows Return updaterRef End Function

Protected Sub GotXML(content as string) #pragma BreakOnExceptions off FoundOlderVersion = false FoundNewerVersion = false FoundCurrentVersion = false dim x as XmlDocument try x = new XmlDocument(content) catch break // xml wrong? MsgBox kFailedToFindUpdate Return end try if WalkXML(x) then Return // shows update dialog end if Exception r as RuntimeException break // some exception in xml walking Finally if Manually then if FoundNewerVersion then // we found an update and the update window is shown // or found ignored update so we do nothing elseif FoundCurrentVersion then // we found the version which is running MsgBox Replace(kYouhavethecurrentversion, "%", appname) elseif FoundOlderVersion then // user have a newer version, maybe a beta, so we show dialog that no newer code MsgBox Replace(kYouhavethecurrentversion, "%", appname) else // we failed to find the update MsgBox kFailedToFindUpdate end if end if End Sub

Protected Function HasInternetConnection() As Boolean Dim s as string = DNSNameToAddressMBS(domainName) if len(s) > 0 then Return true end if End Function

Protected Sub Init(u as string, ApplicationName as string = "") url = u regkeyname = MakeRegkeyname(u) domainName = FindDomainName(u) appname = ApplicationName if len(appname)=0 then // no name provided appname = app.ExecutableFile.Name appname = Replace(appname, ".exe", "") appname = Replace(appname, ".app", "") appname = Replace(appname, ".debug", "") end if if DebugBuild then Return // no update checking on debugging end if CheckUpdateMac if SecondLaunchFlag and updaterref=Nil then if automaticallyCheckForUpdates then SearchUpdate false end if end if SecondLaunchFlag = true End Sub

Protected Function LoadPrefValue(key as string) As string #if TargetMacOS then dim p as CFPreferencesMBS dim o as CFObjectMBS dim s as CFStringMBS p=new CFPreferencesMBS o=p.CopyAppValue(NewCFStringMBS(key),p.kCFPreferencesCurrentApplication) if o isa CFStringMBS then s=CFStringMBS(o) Return s end if #elseif TargetWin32 then dim SoftwareFolder as new registryitem("HKEY_CURRENT_USER\Software") dim DataFolder as RegistryItem = SoftwareFolder.AddFolder(regkeyname) return DataFolder.Value(key) #endif End Function

Private Function MakeRegkeyname(url as string) As string url = ReplaceAll(url, "/", "-") url = ReplaceAll(url, ":", "") Return url End Function

Protected Sub Reset() LastUpdateVersion = "" SecondLaunchFlag = false automaticallyCheckForUpdates = true End Sub

Protected Sub SavePrefValue(key as string, value as string) #if TargetMacOS then dim p as new CFPreferencesMBS p.SetAppValue NewCFStringMBS(key), NewCFStringMBS(value), p.kCFPreferencesCurrentApplication call p.AppSynchronize(p.kCFPreferencesCurrentApplication) #elseif TargetWin32 then dim SoftwareFolder as new registryitem("HKEY_CURRENT_USER\Software") dim DataFolder as RegistryItem = SoftwareFolder.AddFolder(regkeyname) DataFolder.Value(key)=value #endif End Sub

Protected Sub SearchUpdate(manuell as Boolean) // Searches for updates 'if DebugBuild then Return // disable in debugging Manually = manuell if Manually then LastUpdateVersion = "" // reset update counter end if if HasInternetConnection then updatesocket=New UpdateURLConnection 'UpdaterEngine.SetSocketProxy updatesocket #if UseCURL then CURLSearchUpdate updatesocket #Else // query update server via HTTPSocket. Can be changed to HTTPSecureSocket if needed 'updatesocket.SetRequestHeader "Accept", "" 'updatesocket.SetRequestHeader "Host", "" 'updatesocket.SetRequestHeader "Accept-Language", "" 'updatesocket.SetRequestHeader "Accept-Encoding", "gzip, deflate" 'updatesocket.SetRequestHeader "Connection", "keep-alive" updatesocket.Send("GET", URL) #endif else if manuell then MsgBox kNoInternetConnection end if end if End Sub

Protected Sub SetSocketProxy(h as HTTPSecureSocket) // Sets the proxy properties of a httpsocket #if TargetWin32 then SetSocketProxyWindows h #endif #if TargetMachO then SetSocketProxyMac h #endif End Sub

Private Sub SetSocketProxyMac(h as HTTPSecureSocket) // Internal method to load the proxy settings from Mac OS X SystemConfiguration database #if TargetMachO then dim s as new SystemConfigurationMBS dim p as new SCPreferencesMBS if p.Create(NewCFStringMBS("TestRB"),Nil) then // currentset is a CFString // and can be used as key in the Network Services. dim o as CFObjectMBS = p.GetValue(s.kSCPrefCurrentSet) dim currentset as CFStringMBS = CFStringMBS(o) 'CFShowMBS currentset // Find the value for this path and get the dictionary dim cd as CFDictionaryMBS=p.GetPathValue(currentset) 'CFShowMBS cd // get the network stuff in this dictionary o=cd.Value(NewCFStringMBS("Network")) if o isa CFDictionaryMBS then cd=CFDictionaryMBS(o) 'CFShowMBS cd // get the list of services o=cd.Value(NewCFStringMBS("Service")) if o isa CFDictionaryMBS then cd=CFDictionaryMBS(o) 'CFShowMBS cd // now we try each of them dim cdl as CFDictionaryListMBS=cd.List dim c as integer=cdl.Count-1 for i as integer=0 to c FindProxyInNetworkService(h, cdl.Value(i),s,p) next end if end if end if #endif Exception r as runtimeexception End Sub

Private Sub SetSocketProxyWindows(h as HTTPSecureSocket) // Internal method to load the proxy settings from Windows #if TargetWin32 then dim w as new WindowsProxyMBS if w.UsingProxy then dim s as string = w.Proxy if len(s)>0 then dim c as integer = CountFields(s, " ") if c = 1 then // only one proxy SetSocketProxyWindows h, s else // we have several, pick one dim items(-1) as string = split(s, " ") for each item as string in items dim p as integer = instr(item, "=") dim protocol as string = left(item, p-1) dim proxy as string = mid(item, p+1) if protocol = "http" then SetSocketProxyWindows h, proxy end if next end if end if end if #else #pragma Unused h #endif End Sub

Private Sub SetSocketProxyWindows(sock as HTTPSecureSocket, proxy as string) // Internal method to parse the proxy settings from Windows and set them on the socket #if TargetWin32 then dim nameString as string = NthField(proxy, ":", 1) dim portString as string = NthField(proxy, ":", 2) dim port as integer = val(portString) if nameString <> "" then sock.HTTPProxyAddress = nameString end if if port>0 then sock.HTTPProxyPort = port end if #else #pragma Unused sock #pragma Unused proxy #endif End Sub

Protected Sub TestCases() // Some test cases to verify some of the core functions do work dim lines(-1) as string dim s as string s = findDomainName("https://www.test.com/test/file") if s <> "www.test.com" then lines.Append "findDomainName 1 failed: "+s end if s = findDomainName("https://www.test.com/") if s <> "www.test.com" then lines.Append "findDomainName 2 failed: "+s end if s = findDomainName("https://www.test.com") if s <> "www.test.com" then lines.Append "findDomainName 3 failed: "+s end if if VersionIsNewer("1","2")=false then lines.Append "VersionIsNewer 1 failed" end if if VersionIsNewer("2","1")=true then lines.Append "VersionIsNewer 2 failed" end if if VersionIsNewer("1","1.2")=false then lines.Append "VersionIsNewer 3 failed" end if if VersionIsNewer("1.2","1")=true then lines.Append "VersionIsNewer 4 failed" end if if VersionIsNewer("1.1","1.2")=false then lines.Append "VersionIsNewer 5 failed" end if if VersionIsNewer("1.2","1.1")=true then lines.Append "VersionIsNewer 6 failed" end if if VersionIsNewer("1.1","1.1.1")=false then lines.Append "VersionIsNewer 7 failed" end if if VersionIsNewer("1.2","1.1.1")=true then lines.Append "VersionIsNewer 8 failed" end if if VersionIsNewer("1.1.1","1.1.2")=false then lines.Append "VersionIsNewer 9 failed" end if if VersionIsNewer("1.1.2","1.1.1")=true then lines.Append "VersionIsNewer 10 failed" end if if VersionIsNewer("1.1.1r1","1.1.1r2")=false then lines.Append "VersionIsNewer 11 failed" end if if VersionIsNewer("1.1.1r2","1.1.1r1")=true then lines.Append "VersionIsNewer 12 failed" end if If VersionIsNewer("2.0.1b12", "2.0.2")=False Then lines.Append "VersionIsNewer 13 failed" End If If VersionIsNewer("2.0.1.12", "2.0.2")=False Then lines.Append "VersionIsNewer 14 failed" End If if VersionIsNewer("1.21","1.22.5")=false then lines.Append "VersionIsNewer 15 failed" end if if VersionIsNewer("1.21.1.3","1.25")=false then lines.Append "VersionIsNewer 16 failed" end if if VersionIsNewer("1.22.5","1.21")=true then lines.Append "VersionIsNewer 17 failed" end if if VersionIsNewer("1.25","1.21.1.3")=true then lines.Append "VersionIsNewer 18 failed" end if SavePrefValue "test", "1" if LoadPrefValue("test") <> "1" then lines.Append "Preferences failed." end if if UBound(lines)=-1 then MsgBox "OK" else MsgBox Join(lines,EndOfLine) end if End Sub

Protected Function VersionIsNewer(oldVersion as string, newVersion as string) As Boolean // Function to compare two version strings // version strings in name: 2, 3.4, 4.5.6, 7.8.9r10 dim o(-1) as integer // array for old version number dim n(-1) as integer // array for new version number // Parse old version into an array dim oo as integer dim ho as Boolean = false // has digit? for i as integer = 1 to len(oldVersion) dim x as string = mid(oldVersion, i, 1) if asc(x) >= 48 and asc(x) <= 57 then // a digit oo = oo * 10 + (asc(x) - 48) ho = true else if ho then o.Append oo end if ho = false oo = 0 end if next if ho then o.Append oo end if // Parse new version into an array dim nn as integer dim hn as Boolean = false // has digit? for i as integer = 1 to len(newVersion) dim x as string = mid(newVersion, i, 1) if asc(x) >= 48 and asc(x) <= 57 then // a digit nn = nn * 10 + (asc(x) - 48) hn = true else if hn then n.Append nn end if hn = false nn = 0 end if next if hn then n.Append nn end if // Now compare both arrays dim uo as integer = UBound(o) dim un as integer = UBound(n) dim u as integer = uo // get maximum ubound of both arrays if un > uo then u = un // we add zeros on the end to fill version numbers while UBound(o)<u o.Append 0 wend while UBound(n)<u n.Append 0 wend // compare each part for i as integer = 0 to u if n(i) > o(i) then // newer? Return true elseif n(i) < o(i) then // older? Return false end if next // equal if un>uo then // newer version has longer version string. 1.2.3 is newer than 1.2 Return true end if End Function

Private Function WalkChannel(x as XmlNode) As Boolean // Now check all item nodes dim c as integer = x.ChildCount-1 for i as integer = 0 to c dim n as XmlNode = x.Child(i) if n <> Nil and n.LocalName="item" then if walkItem(n) then Return true end if end if next End Function

Private Function WalkRSS(x as XmlNode) As Boolean // go over the RSS feed and check all channels for updates dim c as integer = x.ChildCount-1 for i as integer = 0 to c dim n as XmlNode = x.Child(i) if n <> Nil and n.LocalName="channel" then if walkChannel(n) then Return true end if end if next End Function

Private Function WalkXML(x as XmlNode) As Boolean // find the RSS items in the xml tree dim c as integer = x.ChildCount-1 for i as integer = 0 to c dim n as XmlNode = x.Child(i) if n <> Nil and n.LocalName="rss" then if walkRSS(n) then Return true end if end if next End Function

Private Function walkItem(x as XmlNode) As Boolean // Check an item node dim enclosureNode as XmlNode = FindChild(x, "enclosure") // dim DescriptionNode as XmlNode = FindChild(x, "description") // dim pubDateNode as XmlNode = FindChild(x, "pubDate") // dim TitleNode as XmlNode = FindChild(x, "title") // dim pubDate as string = GetTextChild(pubDateNode) // dim Title as string = GetTextChild(TitleNode) dim Description as string = FindDescriptionURL(x) #if Target32Bit then const bits = "32" #elseif Target64Bit then const bits = "64" #else break //? #endif dim URL as string = enclosureNode.GetAttribute(kURLNodeName+Bits) Dim version As String = enclosureNode.GetAttribute("sparkle:shortVersionString") if version = "" then // alternative node name version = enclosureNode.GetAttribute("sparkle:version") End If // dim dsaSignature as string = enclosureNode.GetAttribute("sparkle:dsaSignature") Dim length As String = enclosureNode.GetAttribute(kLengthNodeName+Bits) // dim type as string = enclosureNode.GetAttribute("type") Dim checksum As String = enclosureNode.GetAttribute(kCheckSumNodeName+Bits) // todo: add check for date if DebugBuild then System.DebugLog "New Version: "+Version+", LastUpdateVersion: "+LastUpdateVersion+", My Version: "+app.ShortVersion System.DebugLog "URL: "+url System.DebugLog "length: "+length System.DebugLog "checksum: "+checksum end if if app.ShortVersion = Version then // same version FoundCurrentVersion = true // version newer? elseif VersionIsNewer(app.ShortVersion, Version) then // you can overwrite display version number with this xml key: dim shortVersion as string = enclosureNode.GetAttribute("sparkle:shortVersionString") If shortVersion<>"" then version = shortVersion FoundNewerVersion = true LastUpdateVersion = Version // Show GUI for installing update UpdateWindow.Init Version, Description, URL, val(length), checksum, appname Return true else // Well, we didn't find the same version and we didn't find a newer version so our app must be newer than what is in the XML file FoundOlderVersion = true end if Exception n as NilObjectException End Function

Property Protected CURLForSearchUpdate As Variant

Property Protected CURLMulti As Variant

Property Protected CURLMultiTimer As timer

Property Private FoundCurrentVersion As Boolean

Property Private FoundNewerVersion As Boolean

Property Private FoundOlderVersion As Boolean

Property Private Manually As Boolean

Property Protected TestWindowsOnMac As Boolean = false

Property Private URL As string

Property Private appname As string

Property Protected domainName As string

Property Private regkeyname As string

Property Private updaterRef As Variant

Property Private updatesocket As UpdateURLConnection

End Module

Class UpdateWindow Inherits Window

Const kCancel = "Cancel"

Const kDownloadingDots = "Downloading..."

Const kFailedToDownloadFile = "Failed to download file. We got less bytes than we should."

Const kFailedToDownloadFile2 = "Failed to download file. The file does not match the checksum."

Const kFailedToLaunchUpdater = "Failed to launch the updater. Error %"

Const kFailedToWriteUpdater = "Failed to write the updater to disc. No update was installed. "

Const kInstallUpdate = "Install Update"

Const kNetworkError = "Download failed with a network error."

Const kNewUpdateAvailable = "A new version of % is available!"

Const kReleaseNotesLabel = "Release notes:"

Const kRemindMeLater = "Remind Me Later"

Const kSkipThisVersion = "Skip This Version"

Const kUpdateWindowTitle = "Software Update"

Const kXIsAvailable = "%1 %2 is now available—you have %3. Would you like to download it now?"

EventHandler Sub Close() #if UpdaterEngine.UseCURL then if CURLForDownload <> nil then dim c as CURLSMBS = CURLForDownload c.Cancel = true end if #endif End EventHandler

Protected Sub CURLDownloadFinished(c as object, ResultCode as Integer) // remove this function if you don't use CURL! #if UpdaterEngine.UseCURL then dim curl as CURLSMBS = CURLSMBS(c) CURLForDownload = nil dim h as integer = curl.GetInfoResponseCode if ResultCode <> 0 or h <> 200 then // problem? dim DebugMessages as string = curl.DebugData // fix encoding if none is known if DebugMessages.Encoding = nil then if encodings.UTF8.IsValidData(DebugMessages) then DebugMessages = DefineEncoding(DebugMessages, encodings.UTF8) else DebugMessages = DefineEncoding(DebugMessages, encodings.ISOLatin1) end if end if DebugMessages = ReplaceLineEndings(DebugMessages, EndOfLine) // write log file try dim f as FolderItem = SpecialFolder.Preferences.Child("Updater.log") dim t as TextOutputStream = TextOutputStream.Create(f) t.Write DebugMessages catch io as IOException // ignore write error end try break // check debug messages if ControlCount = 0 then // window already closed Return end if dim msg as string UpdaterEngine.LastUpdateVersion = "" // retry on next run Select case ResultCode case CURLSMBS.kError_COULDNT_CONNECT msg = "Failed to connect to server." case CURLSMBS.kError_COULDNT_RESOLVE_HOST msg = "Failed to find IP for update server." case CURLSMBS.kError_COULDNT_RESOLVE_PROXY msg = "Failed to find IP for proxy server." case CURLSMBS.kError_ABORTED_BY_CALLBACK Return // ignore, as cancelled by software case CURLSMBS.kError_OUT_OF_MEMORY msg = "Out of memory." end Select select case h case 404 msg = "File not found on server." case 500 msg = "Internal Server Error." case 503 msg = "Service Unavailable." end Select MsgBox kNetworkError+EndOfLine+EndOfLine+"Result: "+str(ResultCode)+" Response: "+str(h)+EndOfLine+msg Return end if if ControlCount = 0 then // window already closed Return end if // normal okay SockPageReceived curl.OutputData #Else #Pragma unused c #Pragma unused ResultCode #EndIf End Sub

Protected Function CURLProgress(c as object, dltotal as Int64, dlnow as Int64, ultotal as Int64, ulnow as Int64, percent as double) As Boolean #Pragma unused c #Pragma unused dltotal #Pragma unused ultotal #Pragma unused dlnow #Pragma unused ulnow #Pragma unused percent #If UpdaterEngine.UseCURL Then if ControlCount = 0 then // window already closed Return true end if // update progress bar bar.Value = percent #EndIf End Function

Protected Sub CURLStartDownload() #if UpdaterEngine.UseCURL then // query update file via CURL dim UpdateCURL as new CURLSMBS UpdateCURL.OptionURL = DownloadURL UpdateCURL.CollectOutputData = true UpdateCURL.CollectDebugData = true UpdateCURL.CollectHeaderData = true AddHandler UpdateCURL.Finished, AddressOf CURLDownloadFinished AddHandler UpdateCURL.Progress, AddressOf CURLProgress // copy proxy setting, or set yourself here: if sock.HTTPProxyAddress <> "" then if sock.HTTPProxyPort > 0 then UpdateCURL.OptionProxy = sock.HTTPProxyAddress+":"+str(sock.HTTPProxyPort) else UpdateCURL.OptionProxy = sock.HTTPProxyAddress end if end if UpdaterEngine.CURLConfigure UpdateCURL UpdaterEngine.CURLRun UpdateCURL CURLForDownload = UpdateCURL #endif End Sub

Private Function FindTempFile() As FolderItem // Find a random name for the installer file dim n as integer = 0 dim f as FolderItem = SpecialFolder.Temporary.Child("install.exe") while f=Nil or f.Exists n = n + 1 f = SpecialFolder.Temporary.Child("install"+str(n)+".exe") wend Return f End Function

Sub Init(Version as string, DescriptionURL as string, theDownloadURL as string, theLength as integer, theChecksum as string, appname as string) // initialize the dialog and load the description webpage Title = kUpdateWindowTitle DownloadURL = theDownloadURL DownloadLength = theLength DownloadCheckSum = theChecksum Info1.text = Replace(kNewUpdateAvailable, "%", appname) Info2.text = Replace(Replace(Replace(kXIsAvailable, "%3", app.ShortVersion), "%2", Version), "%1", appname) web.LoadURL DescriptionURL show End Sub

Private Sub SockError(code as integer) // We got a socket error: if ControlCount = 0 then // window already closed Return end if UpdaterEngine.LastUpdateVersion = "" // retry on next run // display some message text. We don't localize it, but we can show it at least for our support hotline dim msg as string select case code case 0 Msg = ": No error." case 100 Msg = ": There was an error opening and initializing the drivers." case 102 Msg = ": This code means that you lost your connection." case 103 Msg = ": Unable to resolve the address that was specified." case 107 Msg = ": This error means that the port you specified is invalid." case 108 Msg = ": This error indicates that your application has run out of memory." end Select MsgBox kNetworkError+EndOfLine+EndOfLine+str(code)+msg End Sub

Private Sub SockPageReceived(content as string) // We got a file from the webserver and now we check whether it is okay, write it to a file and launch it. // Check Length of file dim Length as integer = lenb(content) if DebugBuild then System.DebugLog "Got length: "+str(length)+" "+str(DownloadLength) end if if Length <> DownloadLength then MsgBox kFailedToDownloadFile Return end if // Check MD5 Checksum if we have one if len(DownloadCheckSum)>0 then dim checksum as string = MD5StringMBS(content) if DebugBuild then System.DebugLog "Got checksum: "+str(checksum)+" "+str(DownloadCheckSum) end if if checksum <> DownloadCheckSum then MsgBox kFailedToDownloadFile2 Return end if end if // todo: signature check like in Sparkle? // Now write installer to disc dim f as FolderItem = FindTempFile dim b as BinaryStream try b = BinaryStream.Create(f, true) catch i as IOException UpdaterEngine.LastUpdateVersion = "" // retry on next run MsgBox kFailedToWriteUpdater Return end try b.Write content b.Close // launch it f.Launch(true) // Check error from launching dim e as integer = f.LastErrorCode if e <> 0 then MsgBox Replace(kFailedToLaunchUpdater,"%",str(e)) else quit end if End Sub

Property Private CURLForDownload As Variant

Property Private DownloadCheckSum As string

Property Private DownloadLength As Integer

Property Private DownloadURL As string

Property Protected RedirectCount As Integer

End Class

Class UpdateURLConnection Inherits URLConnection

EventHandler Sub ContentReceived(URL As String, HTTPStatus As Integer, content As String) If HTTPStatus >= 300 And httpStatus <= 399 Then // redirect RedirectCount = RedirectCount + 1 If RedirectCount >= 5 Then UpdaterEngine.DisplayError "Too many redirects." Return End If // get new URL Dim u As String = ResponseHeader("Location") If Len(u)>0 Then // and start a new download self.send("GET", u) Return End If End If // normal okay UpdaterEngine.GotXML content #Pragma Unused url End EventHandler

Property Protected RedirectCount As Integer

End Class

ExternalFile Info

End ExternalFile