You've already forked lazarus-ccr
13ee2b0f8f
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6801 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2911 lines
99 KiB
ObjectPascal
2911 lines
99 KiB
ObjectPascal
unit ulazautoupdate;
|
|
|
|
{
|
|
Summary and Copyright
|
|
=====================
|
|
LazAutoUpdate (c)2015 Gordon Bamber (minesadorada@charcodelvalle.com)
|
|
A Lazarus Visual component that enables an update service for Executables.
|
|
|
|
Web References
|
|
==============
|
|
Wiki Page: http://wiki.freepascal.org/LazAutoUpdater
|
|
Forum thread: http://forum.lazarus.freepascal.org/index.php/topic,25444.0.html
|
|
SourceForge project: https://sourceforge.net/projects/lazautoupdate/
|
|
|
|
Other Credits
|
|
=============
|
|
VersionSupport: Mike Thompson - mike.cornflake@gmail.com
|
|
(added to and modified by minesadorada@charcodelvalle.com)
|
|
Windows admin RunAs function: Vincent at freepascal forum
|
|
THpttpClient code: GetMem at freepascal forum
|
|
|
|
License
|
|
=======
|
|
This library is free software; you can redistribute it and/or modify it
|
|
under the terms of the GNU Library General Public License as published by
|
|
the Free Software Foundation; either version 2 of the License, or (at your
|
|
option) any later version with the following modification:
|
|
|
|
As a special exception, the copyright holders of this library give you
|
|
permission to link this library with independent modules to produce an
|
|
executable, regardless of the license terms of these independent modules,and
|
|
to copy and distribute the resulting executable under terms of your choice,
|
|
provided that you also meet, for each linked independent module, the terms
|
|
and conditions of the license of that module. An independent module is a
|
|
module which is not derived from or based on this library. If you modify
|
|
this library, you may extend this exception to your version of the library,
|
|
but you are not obligated to do so. If you do not wish to do so, delete this
|
|
exception statement from your version.
|
|
|
|
This program is distributed in the hope that it will be useful, but WITHOUT
|
|
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
|
|
for more details.
|
|
|
|
You should have received a copy of the GNU Library General Public License
|
|
along with this library; if not, write to the Free Software Foundation,
|
|
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
|
|
|
Version Control and History
|
|
===========================
|
|
Via SVN: https://svn.code.sf.net/p/lazarus-ccr/svn/components/lazautoupdate/
|
|
Via SourceForge: https://sourceforge.net/projects/lazautoupdate/
|
|
Also see 'Version History' below
|
|
}
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
|
|
uses
|
|
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
|
cthreads,
|
|
cmem, // the c memory manager is on some systems much faster for multi-threading
|
|
{$ENDIF}{$ENDIF}
|
|
Forms, Classes, SysUtils, lazautoupdate_httpclient, strutils, PropEdits,
|
|
LazUTF8, FileUtil, LazFileUtils, Dialogs, StdCtrls,
|
|
Buttons, DateUtils,{$IFDEF LINUX}process, asyncprocess,{$ENDIF}zipper, LResources,
|
|
VersionSupport, inifiles, aboutlazautoupdateunit, uappisrunning, LCLProc,
|
|
fileinfo, open_ssl, ushortcut, winpeimagereader {need this for reading exe info}
|
|
, elfreader {needed for reading ELF executables}
|
|
, machoreader {needed for reading MACH-O executables}
|
|
{$IFDEF WINDOWS}, Windows, ShellAPI{$ENDIF}; // Thanks to Windows 10 and 704 error
|
|
|
|
const
|
|
C_SOURCEFORGEURL =
|
|
'https://sourceforge.net/projects/%s/files/%s/%s/download';
|
|
// [updatepath,projectname,filename]
|
|
C_GITHUBFILE_URL = 'https://raw.github.com/%s/%s/%s/%s';
|
|
// https://raw.github.com/<username>/<repo>/<branch>/file
|
|
// GitHubUserName,GitHubProjectName,updatepath,filename
|
|
C_GITHUBFILE_URL_UPDATES = 'https://raw.github.com/%s/%s/%s/%s/%s';
|
|
// https://raw.github.com/<username>/<repo>/<branchname>/some_directory/file
|
|
// https://raw.github.com/<username>/<repo>/<tagname>/some_directory/file
|
|
|
|
|
|
{
|
|
Version History
|
|
===============
|
|
V0.0.1: Initial alpha
|
|
V0.0.2: Added auOther properties
|
|
V0.0.3: Limit to download time
|
|
auOther code working
|
|
V0.0.4: Added Events
|
|
V0.0.5: Improved error handling in DownloadNewVersion
|
|
Added LastError property
|
|
Added VersionCountLimit rpoerty
|
|
Added DownloadCountLimit property
|
|
V0.0.6: Linux implementation
|
|
Property CopyTree added
|
|
V0.0.7: Added Sleep(1) to download code
|
|
V0.0.8: UpdateToNewVersion now shells AppFileWithPath
|
|
V0.0.9: AutoUpdate method added
|
|
V0.1.0: Added WaitFor routine to simulate Sleep in Linux
|
|
V0.1.1: Tidied up Debugmode
|
|
Improved version comparison
|
|
V0.1.3: Fixed bug whereby Setting AppVersion property gave incorrect value
|
|
V0.1.4: Added public AppVersionNumber property
|
|
V0.1.5: Added Scrollbars to the WhatsNew memo
|
|
V0.1.6: Added Public ResetAppVersion method
|
|
Added Private VersionStringToNumber function
|
|
V0.1.7: Added Public SilentUpdate method
|
|
Added public properties:
|
|
LCLVersion,WidgetSet, FPCVersion,LastCompiled,TargetOS
|
|
V0.1.8: Bugfix: Removed Parent Form code if fSilentMode=TRUE
|
|
V0.1.9: Added public AppRunningSilentUpdate method
|
|
V0.1.10:Added uAppIsRunning unit
|
|
Added IsAppActive public function
|
|
V0.1.11:SilentInstall method
|
|
V0.1.12:Moved ProgramDir references to fAppFileName references
|
|
V0.1.13:Bugfix Update
|
|
V0.1.14:Added debug messages in DoSilentUpdate method
|
|
V0.1.15:DoSilentUpdate: Added code for CopyTree=TRUE/FALSE
|
|
Changed some Ansi functions to UTF8
|
|
V0.1.16:$IFDEF WINDOWS UpdateToNewVersion kills app if running
|
|
V0.1.17:Added public methods CreateLocalLauImportFile and RelocateLauImportFile
|
|
V0.1.18:Added public method RemoteUpdateToNewVersion
|
|
V0.1.19:Improved VersionStringToNumber
|
|
V0.1.20:Bugfix: 'No Build Information Available' -> '0.0.0.0'
|
|
V0.1.21:Bugfix: RemoteUpdate killed app too soon
|
|
V0.1.22:lauimport file is not re-created if it already exists
|
|
V0.1.23:Bugfix: PrettyName in lauimport sometimes contained duplicated OS info
|
|
V0.1.24:Bugfix to CreateLocalLauImportFile
|
|
More checks on PrettyName
|
|
V0.1.25:Changed default: CopyTree = TRUE
|
|
V0.1.26:Updated uses clause for FileUtils.
|
|
V0.2.0: Rewritten for 2017
|
|
V0.2.4: GitHub integration with branches
|
|
V0.2.5: IsWindowsAdministrator check added and property to control it
|
|
V0.2.6: Enabled GitHub tags (GitHubBranchOrTag property)
|
|
V0.2.7: Updates Tray Updater routines
|
|
V0.2.8: Changed constants C_UPDATEHMNAME and C_LAUUPDATENAME
|
|
V0.2.9: Added CreateLocalLauImportFile in UpdateToNewVersion
|
|
V0.3.1: Added SetExecutePermission (LINUX only)
|
|
V0.3.2: Bugfix for DoSilentUpdate
|
|
V0.3.3: Added event OnUpdate
|
|
V0.3.4: Added unit ushortcut (CreateDesktopShortCut) for installers
|
|
V0.3.5: Rule #3:There is to be NO v0.3.5.0
|
|
V0.3.6: Bugfixed CreateShortCut code
|
|
V0.3.7: Added public property Mode=(lauUpdate|lauInstall)
|
|
V0.3.7.1: Added (DoSilentUpdate) copy C_UPDATEHMNAME to installed folder
|
|
V0.3.7.2: Unix: SetExecutePermissions on installed app
|
|
V0.3.8: Shortcut Menu items now created/deleted
|
|
}
|
|
C_TLazAutoUpdateComponentVersion = '0.3.9.0';
|
|
C_TThreadedDownloadComponentVersion = '0.0.3.0';
|
|
{
|
|
V0.0.1: Initial alpha
|
|
V0.0.2: Added fDebugmode to all classes and functions
|
|
V0.0.3: Changed to http_client
|
|
}
|
|
C_OnlineVersionsININame = 'versions.ini'; // User can change
|
|
C_UpdatesFolder = 'updates'; // User can change
|
|
|
|
// Don't change these without some thought..
|
|
C_LAUTRayINI = 'lauimport.ini'; // Name syncronises with TrayUpdater App
|
|
C_WhatsNewFilename = 'whatsnew.txt';
|
|
C_INISection = 'versions';
|
|
C_GUIEntry = 'GUI';
|
|
C_ModuleEntry = 'Module';
|
|
C_MASTER = 'master';
|
|
// Compiler mode directives
|
|
// (note: nothing for Mac/Darwin)
|
|
{$IFDEF WINDOWS}
|
|
C_OS = 'win';
|
|
{$ELSE}
|
|
C_OS = 'linux';
|
|
{$ENDIF}
|
|
{$IFDEF CPU32}
|
|
C_BITNESS = '32';
|
|
{$ELSE}
|
|
C_BITNESS = '64';
|
|
{$ENDIF}
|
|
C_PFX = C_OS + C_BITNESS; // Used in file naming
|
|
{$IFDEF WINDOWS}
|
|
C_UPDATEHMNAME = 'updatehm' + C_PFX + '.exe';
|
|
C_LAUUPDATENAME = 'lauupdate' + C_PFX + '.exe';
|
|
{$ELSE}
|
|
C_UPDATEHMNAME = 'updatehm' + C_PFX;
|
|
C_LAUUPDATENAME = 'lauupdate' + C_PFX;
|
|
{$ENDIF}
|
|
// Windows Constants (unused)
|
|
C_RUNONCEKEY = 'HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce';
|
|
C_RUNKEY = 'HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run';
|
|
|
|
resourcestring
|
|
C_ComponentPrettyName = 'Lazarus Auto-Update Component';
|
|
C_TempVersionsININame = 'new%s'; // [C_OnlineVersionsININame]
|
|
C_Checking = 'Checking for updates...';
|
|
C_NoSFTypes = 'Sorry only ProjectType = auSourceForge is supported in this version';
|
|
C_Downloading = 'Please wait. Downloading.. ';
|
|
C_ConsoleTitle = 'Updating %s'; //[fAppFileName]
|
|
C_TakingTooLong =
|
|
'Check is taking too long (bad/slow internet connection?). Try again later?';
|
|
C_Error500 = 'There is a problem with the Internet connection (error %d) Try again later?';
|
|
C_Error404 = 'Cannot find the file at this time. (error %d) Try again later?';
|
|
C_UnableToDelete = 'Sorry, unable to delete %s%sPlease delete it manually';
|
|
C_OK = 'OK';
|
|
C_NotProperFileName = 'This is not a proper file name';
|
|
C_WhatsNewInVersion = 'What''s new in version %s';
|
|
C_PropIsEmpty = 'Property SFProjectName is empty!';
|
|
C_ThreadDownloadCrash = 'ThreadDownloadHTTP Crashed! (NewVersionAvailable)';
|
|
C_DownloadedBytes = 'Downloaded %s: %d bytes';
|
|
C_UnableToDeleteOld = 'Unable to delete old files in %s';
|
|
C_DirectoryProblems = 'Problems with the % directory';
|
|
C_ThreadDownloadHTTPCrash = 'ThreadDownloadHTTP Crashed! (NewVersionAvailable)';
|
|
C_DownloadSuccess = 'Downloaded new version %s sucessfully.';
|
|
C_UnableToDownload = 'Unable to download new version%sReturn code was %d';
|
|
C_PleaseWaitProcessing = 'Please wait. Processing....';
|
|
C_UpdaterMissing = 'Missing %s';
|
|
C_FolderMissing = 'Missing %s folder';
|
|
C_NotApplicable = '<not applicable>';
|
|
C_ThreadStarted = 'Thread Started';
|
|
// C_SourceForgeDownload = 'SourceForge download';
|
|
C_CannotLoadFromRemote = 'Cannot load document from remote server';
|
|
C_DownloadIsEmpty = 'Downloaded document is empty.';
|
|
C_DownloadFailedErrorCode = 'Download failed with error code ';
|
|
rsANewVersionS = 'A new version %s is available. Would you like to download it?';
|
|
rsVewVersionSH = 'Vew version %s has downloaded. Click OK to update now.';
|
|
rsCancelledYou = 'Cancelled. You can download and update to the new version' +
|
|
' later.';
|
|
rsDownloadFail = 'Download failed. (HTTP Errorcode %d) Try again later';
|
|
rsCancelledYou2 = 'Cancelled. You can download the new version later.';
|
|
rsThisApplicat = 'This application is up-to-date';
|
|
rsOnlyWindowsU = 'Only Windows users whith Administrator status can update ' +
|
|
'this application.%sPlease log off, then log on as an administrator (or ' +
|
|
'switch users to an administrator account),%sthen try again. This ' +
|
|
'restriction is for the safety and security of your Windows system.%' +
|
|
'sClick OK to continue';
|
|
rsApplicationU = 'Application update';
|
|
rsSImportantMe = '%sImportant message from LazAutoUpdate component:%sThere ' +
|
|
'is no version information in your project!%sClick [Continue], and/or [' +
|
|
'Abort] to quit, and use%sIDE menu item Project/Project Options/Version ' +
|
|
'Info%sto add Version Info by clicking the checkbox.';
|
|
rsNoBuildInfor = 'No build information available';
|
|
|
|
|
|
type
|
|
// Dummy thread to initialise the threading system
|
|
tc = class(tthread)
|
|
procedure Execute; override;
|
|
end;
|
|
|
|
// This type is currently unused
|
|
TProjectType = (auSourceForge, auGitHubReleaseZip, auOther);
|
|
// Array of these records used for multiple updates
|
|
UpdateListRecord = record
|
|
PrettyName: string;
|
|
Path: string;
|
|
VersionString: string;
|
|
VersionNumber: cardinal;
|
|
end;
|
|
|
|
TWorkingMode = (lauUpdate, lauInstall);
|
|
TOnPercent = procedure(Sender: TObject; Percent: integer) of object;
|
|
TDownloadWrapper = class; // Forward declaration
|
|
TShortCutClass = class; // Forward declaration
|
|
TDownloadThreadClass = class; // Forward declaration
|
|
TDataEvent = procedure(Sender: TObject;
|
|
const ContentLength, CurrentPos: int64) of object;
|
|
|
|
{TLAZAUTOUPDATE}
|
|
// Event declarations
|
|
TOnNewVersionAvailable = procedure(Sender: TObject; Newer: boolean;
|
|
OnlineVersion: string) of object;
|
|
TOnDownloaded = procedure(Sender: TObject; ResultCode, BytesDownloaded: integer) of
|
|
object;
|
|
TOnDebugEvent = procedure(Sender: TObject; lauMethodName, lauMessage: string) of
|
|
object;
|
|
TOnUpdated = procedure(Sender: TObject; NewVersion, LauMessage: string) of object;
|
|
|
|
TLazAutoUpdate = class(TAboutLazAutoUpdate)
|
|
private
|
|
fSourceForgeProjectName: string;
|
|
fGitHubProjectName: string;
|
|
fGitHubRepositoryName: string;
|
|
fGitHubBranchOrTag: string;
|
|
fApplicationVersionString: string;
|
|
fApplicationVersionQuad: TVersionQuad;
|
|
fGuiQuad: TVersionQuad;
|
|
fProjectType: TProjectType;
|
|
fDownloadWrapper: TDownloadWrapper;
|
|
fAppFileName: string;
|
|
fComponentVersion: string;
|
|
fShowUpdateInCaption: boolean;
|
|
fUpdateList: array of UpdateListRecord;
|
|
fUpdateListCount: integer;
|
|
fUpdatesFolder: string;
|
|
fDownloadZipName: string;
|
|
fVersionsININame: string;
|
|
fParentApplication: TApplication;
|
|
fParentForm: TForm;
|
|
fGUIOnlineVersion: string;
|
|
fShowDialogs: boolean;
|
|
fDownloadInprogress: boolean;
|
|
fWindowsAdminCheck: boolean;
|
|
fShortCutClass: TShortCutClass;
|
|
fWorkingMode: TWorkingMode;
|
|
{$IFDEF UNIX}
|
|
FUpdateHMProcess: TAsyncProcess;
|
|
{$ENDIF}
|
|
fauOtherSourceURL: string;
|
|
fauOtherSourceFilename: string;
|
|
WhatsNewForm: TForm;
|
|
WhatsNewMemo: TMemo;
|
|
cmdClose: TBitBtn;
|
|
FOnNewVersionAvailable: TOnNewVersionAvailable;
|
|
FOnDownloaded: TOnDownloaded;
|
|
fOnDebugEvent: TOnDebugEvent;
|
|
fOnUpdated: TOnUpdated;
|
|
fLastError: string;
|
|
fVersionCountLimit, fDownloadCountLimit: cardinal;
|
|
fZipfileName: string;
|
|
fCopyTree: boolean;
|
|
fDebugMode, fFireDebugEvent: boolean;
|
|
fSilentMode: boolean;
|
|
fLCLVersion, fWidgetSet, fFPCVersion, fLastCompiled, fTargetOS: string;
|
|
// fQuad: TVersionQuad;
|
|
fProgVersion: TProgramVersion;
|
|
objFileVerInfo: TFileVersionInfo;
|
|
fUpdateExe, fUpdateSilentExe: string;
|
|
flauOnFileWrite: TOnPercent;
|
|
flauOnProgress: TOnPercent;
|
|
procedure SetProjectType(AValue: TProjectType);
|
|
// projectype=auOther property Sets
|
|
procedure SetauOtherSourceFilename(AValue: string);
|
|
procedure SetauOtherSourceURL(AValue: string);
|
|
|
|
procedure SetSourceForgeProjectName(Avalue: string);
|
|
procedure SetAppFilename(Avalue: string);
|
|
procedure SetApplicationVersionString(Avalue: string);
|
|
procedure SetShowDialogs(AValue: boolean);
|
|
procedure SetDebugMode(AValue: boolean);
|
|
function GetThreadDownloadReturnCode: integer;
|
|
function IsOnlineVersionNewer(const sznewINIPath: string): boolean;
|
|
function DoSilentUpdate: boolean;
|
|
function GetUpdateSilentExe: string;
|
|
function GetUpdateExe: string;
|
|
protected
|
|
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure DebugTest;
|
|
{Main functions}
|
|
// If NewVersionAvailable then DownloadNewVersion then UpdateToNewVersion
|
|
// Returns TRUE if GUIVersion > AppVersion
|
|
function NewVersionAvailable: boolean;
|
|
// Returns TRUE if successful
|
|
function DownloadNewVersion: boolean;
|
|
// Returns TRUE if successful. Also creates a C_LAUTRayINI file in the GetAppConfig folder for TrayUpdater
|
|
function UpdateToNewVersion: boolean;
|
|
// Put in form.activate. Shows <whatsnew.txt> only if in ProgramDirectory then deletes it. Exits otherwise
|
|
procedure ShowWhatsNewIfAvailable;
|
|
// Checks for new version then shows dialogs to update
|
|
function AutoUpdate: boolean;
|
|
// No dialogs - what it says on the tin.
|
|
function SilentUpdate: boolean;
|
|
// Used in SilentUpdate. Shells to local lauupdate(.exe)
|
|
function RemoteUpdateToNewVersion: boolean;
|
|
// Returns TRUE if EXEName is running under Windows or Linux
|
|
function AppIsActive(const ExeName: string): boolean;
|
|
|
|
// Resets AppVersion property to the ownling application version
|
|
procedure ResetAppVersion;
|
|
// Create a new lauimport.ini in GetAppConfigDirUTF8 folder
|
|
function CreateLocalLauImportFile: boolean;
|
|
// If lauimport.ini is found in the app folder, move it to the AppData folder
|
|
procedure RelocateLauImportFile;
|
|
// Uses properties in TShortCutClass
|
|
function MakeShortCut: boolean;
|
|
function DeleteShortCut: boolean; // (use fShortCutClass.ShortCutName)
|
|
|
|
// Download lists (now superceded by CopyTree)
|
|
// TODO: Use Indexed properties to handle list access
|
|
function AddToUpdateList(APrettyName, APath, AVersionString: string;
|
|
AVersionNumber: cardinal): integer;
|
|
procedure ClearUpdateList;
|
|
property UpdateListCount: integer read fUpdateListCount;
|
|
|
|
|
|
// GUI can use these properties during and after downloads
|
|
// NewVersionAvailable sets this. It is the online version
|
|
property GUIOnlineVersion: string read fGUIOnlineVersion;
|
|
// Set by NewVersionAvailable and DownLoadNewVersion
|
|
property ReturnCode: integer read GetThreadDownloadReturnCode;
|
|
// Set by NewVersionAvailable and DownLoadNewVersion when running
|
|
property DownloadInprogress: boolean read fDownloadInprogress;
|
|
|
|
// The name of the zipfile in the remote <updates> directory
|
|
property DownloadZipName: string read fDownloadZipName;
|
|
// The Path + Filename of the app to overwite and then run
|
|
property AppFileWithPath: string read fAppFilename write SetAppFilename;
|
|
// The version string of the app to be updated. You can set this to '0.0.0.0' for a definite update.
|
|
property AppVersion: string read fApplicationVersionString
|
|
write SetApplicationVersionString;
|
|
// Can be queried
|
|
property LastError: string read fLastError;
|
|
// Debugging use only
|
|
property DebugMode: boolean read fDebugMode write SetDebugMode;
|
|
// property AppVersionNumber: integer read fApplicationVersionQuad;
|
|
|
|
// Info useful for About dialogs
|
|
property LCLVersion: string read fLCLVersion;
|
|
property WidgetSet: string read fWidgetSet;
|
|
property FPCVersion: string read fFPCVersion;
|
|
property LastCompiled: string read fLastCompiled;
|
|
property TargetOS: string read fTargetOS;
|
|
property WindowsAdminCheck: boolean read fWindowsAdminCheck write fWindowsAdminCheck;
|
|
{$IFDEF LINUX}
|
|
// Used in UpdateToNewVersion
|
|
function SetExecutePermission(const AFileName: string; var AErrMsg: string): boolean;
|
|
{$ENDIF}
|
|
published
|
|
// Events
|
|
property OnNewVersionAvailable: TOnNewVersionAvailable
|
|
read FOnNewVersionAvailable write FOnNewVersionAvailable;
|
|
property OnDownloaded: TOnDownloaded read fOnDownloaded write fOnDownloaded;
|
|
property OnDebugEvent: TOnDebugEvent read fOnDebugEvent write fOnDebugEvent;
|
|
property OnUpdated: TOnUpdated read fOnUpdated write fOnUpdated;
|
|
property OnFileWriteProgress: TOnPercent read flauOnFileWrite write flauOnFileWrite;
|
|
property OnDownloadProgress: TOnPercent read flauOnProgress write flauOnProgress;
|
|
// Embedded class
|
|
property ThreadDownload: TDownloadWrapper
|
|
read fDownloadWrapper write fDownloadWrapper;
|
|
// Set this property before using methods
|
|
property SFProjectName: string read fSourceForgeProjectName
|
|
write SetSourceForgeProjectName;
|
|
// For when fProjectType = auOther
|
|
// Fully qualified URL (not including the filename).
|
|
property auOtherSourceURL: string read fauOtherSourceURL write SetauOtherSourceURL;
|
|
// Just the filename of the file to be downloaded (can be zipped)
|
|
property auOtherSourceFilename: string read fauOtherSourceFilename
|
|
write SetauOtherSourceFilename;
|
|
|
|
property ProjectType: TProjectType
|
|
read fProjectType write SetProjectType default auSourceForge;
|
|
// Version of this component
|
|
property AutoUpdateVersion: string read fComponentVersion;
|
|
// Zipfile contains a whole directory tree (relative to App Directory)
|
|
property CopyTree: boolean read fCopyTree write fCopyTree default True;
|
|
// Default is 'updates' *must be the same in SourceForge file section or GitHub Branch subfolder*
|
|
property UpdatesFolder: string read fUpdatesFolder write fUpdatesFolder;
|
|
// Default=versions.ini File in SourceForge/GitHub /updates folder
|
|
property VersionsININame: string read fVersionsININame write fVersionsININame;
|
|
// Default is to modify parent form's caption during downloads
|
|
property ShowUpdateInCaption: boolean read fShowUpdateInCaption
|
|
write fShowUpdateInCaption default False;
|
|
// Set to FALSE if you want to handle them in form code
|
|
property ShowDialogs: boolean read fShowDialogs write SetShowDialogs default False;
|
|
// How many counts to wait until 'Too long' meesage quits out
|
|
property VersionCountLimit: cardinal read fVersionCountLimit
|
|
write fVersionCountLimit;
|
|
// How many counts to wait until 'Too long' meesage quits out
|
|
property DownloadCountLimit: cardinal read fDownloadCountLimit
|
|
write fDownloadCountLimit;
|
|
// Default is application filename.zip
|
|
property ZipfileName: string read fZipfileName write fZipfileName;
|
|
// Name of Console app
|
|
property UpdateExe: string read GetUpdateExe;
|
|
// Name of Console app
|
|
property UpdateExeSilent: string read GetUpdateSilentExe;
|
|
// Main project name/UserName
|
|
property GitHubProjectname: string read fGitHubProjectName write fGitHubProjectName;
|
|
// Name of your GitHub repository within the project/username
|
|
property GitHubRepositoryName: string read fGitHubRepositoryName
|
|
write fGitHubRepositoryName;
|
|
// Default=master but any branchname or tagname is OK
|
|
property GitHubBranchOrTag: string read fGitHubBranchOrTag write fGitHubBranchOrTag;
|
|
// Install or Update (default=Update)
|
|
property WorkingMode: TworkingMode read fWorkingMode write fWorkingMode;
|
|
// Subproperties available
|
|
property ShortCut: TShortCutClass read fShortCutClass write fShortCutClass;
|
|
end;
|
|
|
|
TShortCutCategory = (scAudioVideo, scAudio, scDevelopment,
|
|
scEducation, scGame, scGraphics, scNetwork, scOffice, scScience, scSettings,
|
|
scSystem, scUtility);
|
|
// TShortCutCategoryFlags = Set of TShortCutCategory;
|
|
|
|
TShortCutClass = class(TPersistent)
|
|
private
|
|
// ShortCut stuff for CreateDesktopShortCut in ushortcut.pas
|
|
fShortCutTarget: string;
|
|
fShortCutTargetArguments: string;
|
|
fShortCutShortcutName: string;
|
|
fShortCutIconFileName: string;
|
|
fShortCutCategory: TShortCutCategory; // For easier property access
|
|
procedure SetShortCutCategoryString(ACategory: TShortCutCategory);
|
|
public
|
|
fShortCutCategoryString: string;
|
|
constructor Create; // Constructor must be public
|
|
destructor Destroy; override; // Destructor must be public
|
|
property CategoryString: string read fShortCutCategoryString;
|
|
published
|
|
property Target: string read fShortCutTarget write fShortCutTarget;
|
|
property TargetArguments: string read fShortCutTargetArguments
|
|
write fShortCutTargetArguments;
|
|
property ShortcutName: string read fShortCutShortcutName write fShortCutShortcutName;
|
|
property IconFileName: string read fShortCutIconFileName write fShortCutIconFileName;
|
|
property Category: TShortCutCategory read fShortCutCategory
|
|
write SetShortCutCategoryString;
|
|
end;
|
|
|
|
{TDownloadWrapper }
|
|
TDownloadWrapper = class(TPersistent)
|
|
private
|
|
fURL: string;
|
|
fFileName: string;
|
|
fReturnCode: integer;
|
|
fThreadFinished: boolean;
|
|
fDownloadSize: integer;
|
|
fUnzipAfter: boolean;
|
|
fComponentVersion: string;
|
|
fApplicationVersionString: string;
|
|
fIsCodeRepository: boolean;
|
|
public
|
|
fDownloadWrapperPercent: integer;
|
|
fWrapperOnFileWrite: TOnPercent;
|
|
fDownLoad: TDownloadThreadClass;
|
|
fDebugMode: boolean;
|
|
fShowDialogs: boolean;
|
|
fLastError: string; // Propagated to TLazAutoUpdate
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
//function GetDownloadWrapperPercent:Integer;
|
|
// Starts the thread
|
|
function ThreadDownloadHTTP: boolean;
|
|
// Called when the thread is done
|
|
procedure DownloadTerminiated(Sender: TObject);
|
|
// Passed to the thread
|
|
property URL: string read fURL write fURL;
|
|
// Passed to the thread
|
|
property Filename: string read fFileName write fFileName;
|
|
// From TLazAutoUpdate
|
|
property AppVersion: string read fApplicationVersionString
|
|
write fApplicationVersionString;
|
|
// From the thread
|
|
property ReturnCode: integer read fReturnCode write fReturnCode;
|
|
// From DownloadTerminated
|
|
property ThreadFinished: boolean read fThreadFinished write fThreadFinished;
|
|
// From the thread
|
|
property DownloadSize: integer read fDownloadSize write fDownloadSize;
|
|
// From TLazAutoUpdate
|
|
property UnzipAfter: boolean read fUnzipAfter;
|
|
// From TLazAutoUpdate
|
|
property IsSourceForge: boolean read fIsCodeRepository;
|
|
property OnDownloadWrapperFileWriteProgress: TOnPercent
|
|
read fWrapperOnFileWrite write fWrapperOnFileWrite;
|
|
property DownloadWrapperPercent: integer
|
|
read fDownloadWrapperPercent write fDownloadWrapperPercent;
|
|
published
|
|
// Version of the underlying thread class
|
|
property ThreadDownloadVersion: string read fComponentVersion;
|
|
end;
|
|
|
|
{ TStreamAdapter }
|
|
TStreamAdapter = class(TStream)
|
|
strict private
|
|
fOnProgress: TOnPercent;
|
|
fPercent: integer;
|
|
fStream: TStream;
|
|
public
|
|
constructor Create(AStream: TStream; ASize: int64);
|
|
destructor Destroy; override;
|
|
function Read(var Buffer; Count: longint): longint; override;
|
|
function Write(const Buffer; Count: longint): longint; override;
|
|
function Seek(Offset: longint; Origin: word): longint; override;
|
|
procedure DoProgress(Writing: boolean); virtual;
|
|
published
|
|
property OnFileWriteProgress: TOnPercent read FOnProgress write FOnProgress;
|
|
end;
|
|
|
|
{TDownloadThreadClass }
|
|
TDownloadThreadClass = class(TThread)
|
|
private
|
|
fdtcOnFileWrite: TOnPercent;
|
|
fThreadDataEvent: TDataEvent;
|
|
fPercent: integer;
|
|
public
|
|
fHTTPClient: TFPHTTPClient;
|
|
fIsRepositoryURL: boolean; // Propagated from TLazAutoUpdate
|
|
fDebugMode: boolean; // propagated from TLazAutoUpdate
|
|
fShowDialogs: boolean; // propagated from TLazAutoUpdate
|
|
fDownloadSize: integer; // propagated to TDownloadWrapper
|
|
fReturnCode: integer; // Propagated to TDownloadWrapper
|
|
fLastError: string; // Propagated to TDownloadWrapper
|
|
fURL: string;
|
|
fFileName: string;
|
|
constructor Create(CreateSuspended: boolean);
|
|
destructor Destroy; override;
|
|
procedure Execute; override; // Starts thread
|
|
function GetPercent: integer;
|
|
procedure SetPercent(AValue: integer);
|
|
function DownloadHTTP(URL, TargetFile: string; var ReturnCode, DownloadSize: integer;
|
|
bIsRepositoryURL, DebugMode: boolean): boolean;
|
|
procedure DoPercent(Sender: TObject; const ContentLength, CurrentPos: int64);
|
|
function GetDownloadFileSize(URL: string; bIsRepositoryURL: boolean): int64;
|
|
property Percent: integer read fPercent write fPercent;
|
|
property OnThreadFileWriteProgress: TOnPercent
|
|
read fdtcOnFileWrite write fdtcOnFileWrite;
|
|
property OnThreadDataEvent: TDataEvent read fThreadDataEvent write fThreadDataEvent;
|
|
end;
|
|
|
|
// For the TShortCutClass filename properties (needs propedits unit)
|
|
TMyFileNamePropertyEditor = class(TFileNamePropertyEditor)
|
|
public
|
|
// Override the Edit method for total control
|
|
function GetFilter: string; override;
|
|
function GetDialogOptions: TOpenOptions; override;
|
|
function GetDialogTitle: string; override;
|
|
end;
|
|
|
|
|
|
// Non-threaded function
|
|
// Function GetDownloadFileSize(URL:String;bIsRepositoryURL:Boolean):Int64;
|
|
|
|
procedure Register;
|
|
|
|
implementation
|
|
|
|
procedure Register;
|
|
begin
|
|
{$I lazautoupdate_icon.lrs}
|
|
RegisterComponents('System', [TLazAutoUpdate]);
|
|
// Register the custom property editors for the TShortCutClass filename properties
|
|
RegisterPropertyEditor(TypeInfo(string),
|
|
TShortCutClass, 'Target', TMyFileNamePropertyEditor);
|
|
RegisterPropertyEditor(TypeInfo(string),
|
|
TShortCutClass, 'IconFileName', TMyFileNamePropertyEditor);
|
|
end;
|
|
|
|
// Start Property editors for File type properties in TShortCutClass
|
|
function TMyFileNamePropertyEditor.GetFilter: string;
|
|
begin
|
|
{$IFDEF WINDOWS}
|
|
Result := 'Windows executable|*.exe|All Files|*.*';
|
|
{$ELSE}
|
|
{$IFDEF LINUX}
|
|
Result := 'Linux executable|*.|All Files|*.*';
|
|
{$ELSE}
|
|
Result := 'All Files|*.*';
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TMyFileNamePropertyEditor.GetDialogOptions: TOpenOptions;
|
|
begin
|
|
// To see the full list, drop an OpenDialog onto a form and see the Options property
|
|
Result := [ofFileMustExist, ofPathMustExist];
|
|
end;
|
|
|
|
function TMyFileNamePropertyEditor.GetDialogTitle: string;
|
|
begin
|
|
Result := 'Choose Shortcut Target Filename';
|
|
end;
|
|
// End Property editors for File type properties in TShortCutClass
|
|
|
|
// Dummy thread to initialise the threading process
|
|
procedure tc.Execute;
|
|
begin
|
|
|
|
end;
|
|
|
|
procedure WaitFor(const MillisecondDelay: longword);
|
|
// Linux - this proc is intentionally thread-blocking
|
|
var
|
|
ThisSecond: longword;
|
|
begin
|
|
ThisSecond := MilliSecondOfTheDay(Now);
|
|
while MilliSecondOfTheDay(Now) < (ThisSecond + MillisecondDelay) do ;
|
|
end;
|
|
|
|
procedure TShortCutClass.SetShortCutCategoryString(ACategory: TShortCutCategory);
|
|
{
|
|
FreeDesktop Valid Categories:
|
|
TShortCutCategory = (scAudioVideo,scAudio,scDevelopment,
|
|
scEducation,scGame,scGraphics,scNetwork,scOffice,scScience,scSettings,
|
|
scSystem,scUtility);
|
|
}
|
|
begin
|
|
if ACategory = fShortCutCategory then
|
|
exit;
|
|
|
|
fShortCutCategoryString := 'Unknown';
|
|
case ACategory of
|
|
scAudioVideo: fShortCutCategoryString := 'AudioVideo';
|
|
scAudio: fShortCutCategoryString := 'Audio';
|
|
scDevelopment: fShortCutCategoryString := 'Development';
|
|
scEducation: fShortCutCategoryString := 'Education';
|
|
scGame: fShortCutCategoryString := 'Game';
|
|
scGraphics: fShortCutCategoryString := 'Graphics';
|
|
scNetwork: fShortCutCategoryString := 'Network';
|
|
scOffice: fShortCutCategoryString := 'Office';
|
|
scScience: fShortCutCategoryString := 'Science';
|
|
scSettings: fShortCutCategoryString := 'Settings';
|
|
scSystem: fShortCutCategoryString := 'System';
|
|
scUtility: fShortCutCategoryString := 'Utility';
|
|
end;
|
|
end;
|
|
|
|
procedure TLazAutoUpdate.DebugTest;
|
|
begin
|
|
ShowMessage(fApplicationVersionString);
|
|
end;
|
|
|
|
{$IFDEF WINDOWS}
|
|
// === START WINDOWS PROCS =====================================================
|
|
// This is all about permissions in Windows 10
|
|
procedure ShowAdminCheckMessage;
|
|
var
|
|
sMessage: string;
|
|
begin
|
|
sMessage := Format(rsOnlyWindowsU, [lineending, lineending, lineending]);
|
|
MessageDlg(rsApplicationU, sMessage, mtInformation, [mbOK], 0);
|
|
end;
|
|
|
|
function IsXP: boolean;
|
|
var
|
|
osVinfo: TOSVERSIONINFO;
|
|
begin
|
|
ZeroMemory(@osVinfo, SizeOf(osVinfo));
|
|
OsVinfo.dwOSVersionInfoSize := SizeOf(TOSVERSIONINFO);
|
|
if ((GetVersionEx(osVInfo) = True) and (osVinfo.dwPlatformId =
|
|
VER_PLATFORM_WIN32_NT) and (osVinfo.dwMajorVersion = 5) and
|
|
(osVinfo.dwMinorVersion = 1)) then
|
|
Result := True
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
function IsWindowsAdmin: boolean;
|
|
const
|
|
SECURITY_NT_AUTHORITY: TSIDIdentifierAuthority =
|
|
(Value: (0, 0, 0, 0, 0, 5));
|
|
SECURITY_BUILTIN_DOMAIN_RID = $00000020;
|
|
DOMAIN_ALIAS_RID_ADMINS = $00000220;
|
|
var
|
|
hAccessToken: THandle;
|
|
ptgGroups: PTokenGroups;
|
|
dwInfoBufferSize: DWORD;
|
|
psidAdministrators: PSID;
|
|
x: integer;
|
|
bSuccess: BOOL;
|
|
LastError: integer;
|
|
begin
|
|
|
|
if Win32Platform <> VER_PLATFORM_WIN32_NT then
|
|
begin
|
|
Result := True;
|
|
exit;
|
|
end;
|
|
|
|
Result := False;
|
|
bSuccess := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True, hAccessToken);
|
|
if not bSuccess then
|
|
begin
|
|
if GetLastError = ERROR_NO_TOKEN then
|
|
bSuccess := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, hAccessToken);
|
|
end;
|
|
if bSuccess then
|
|
begin
|
|
GetMem(ptgGroups, 1024);
|
|
bSuccess := GetTokenInformation(hAccessToken, TokenGroups,
|
|
ptgGroups, 1024, @dwInfoBufferSize);
|
|
LastError := GetLastError;
|
|
if not bSuccess then
|
|
ShowMessage(format('GetLastError %d', [LastError]));
|
|
CloseHandle(hAccessToken);
|
|
if bSuccess then
|
|
begin
|
|
AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2,
|
|
SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS,
|
|
0, 0, 0, 0, 0, 0, psidAdministrators);
|
|
{$R-}
|
|
for x := 0 to ptgGroups^.GroupCount - 1 do
|
|
if EqualSid(psidAdministrators, ptgGroups^.Groups[x].Sid) then
|
|
begin
|
|
Result := True;
|
|
break;
|
|
end;
|
|
{$R+}
|
|
FreeSid(psidAdministrators);
|
|
end;
|
|
FreeMem(ptgGroups);
|
|
end;
|
|
end;
|
|
|
|
function IsWindowsAdminWinXP: boolean; // Currently unused
|
|
const
|
|
GENERIC_READ = $80000000;
|
|
GENERIC_WRITE = $40000000;
|
|
GENERIC_EXECUTE = $20000000;
|
|
GENERIC_ALL = $10000000;
|
|
var
|
|
hSC: THandle;
|
|
begin
|
|
Result := True;
|
|
hSC := OpenSCManager(nil, nil, GENERIC_READ or GENERIC_WRITE or GENERIC_EXECUTE);
|
|
|
|
if (hSC = 0) then
|
|
Result := False;
|
|
CloseServiceHandle(hSC);
|
|
end;
|
|
|
|
{$ENDIF}
|
|
// === END WINDOWS PROCS =======================================================
|
|
constructor TShortCutClass.Create;
|
|
begin
|
|
inherited Create; // TComponent method;
|
|
end;
|
|
|
|
destructor TShortCutClass.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
|
|
constructor TLazAutoUpdate.Create(AOwner: TComponent);
|
|
var
|
|
sz: string;
|
|
begin
|
|
inherited Create(AOwner); // TComponent method;
|
|
|
|
{ initialise threading system }
|
|
with tc.Create(False) do
|
|
begin
|
|
waitfor;
|
|
Free;
|
|
end;
|
|
|
|
// Freed in Destroy
|
|
fDownloadWrapper := TDownloadWrapper.Create;
|
|
// Freed in Destroy
|
|
fShortCutClass := TShortCutClass.Create();
|
|
|
|
fShortCutClass.ShortcutName := 'MyShortcutName';
|
|
fShortCutClass.TargetArguments := '';
|
|
fShortCutClass.Category := scDevelopment;
|
|
fShortCutClass.fShortCutCategoryString := 'Development';
|
|
// Leave URL and Filename to be set via properties
|
|
fComponentVersion := C_TLazAutoUpdateComponentVersion;
|
|
// Unused
|
|
ClearUpdateList;
|
|
fUpdateListCount := 0;
|
|
|
|
// Grab the application and form objects from the application
|
|
fParentApplication := Tapplication(AOwner.Owner);
|
|
fParentForm := TForm(AOwner);
|
|
// Set default
|
|
fApplicationVersionString := rsNoBuildInfor;
|
|
// Get Versioninfo
|
|
objFileVerInfo := TFileVersionInfo.Create(fParentApplication);
|
|
try
|
|
try
|
|
objFileVerInfo.Filename := ParamStrUTF8(0);
|
|
objFileVerInfo.ReadFileInfo;
|
|
fApplicationVersionString := objFileVerInfo.VersionStrings.Values['FileVersion'];
|
|
fileinfo.GetProgramVersion(fApplicationVersionQuad);
|
|
fileinfo.GetProgramVersion(fProgVersion);
|
|
except
|
|
// EResNotFound raised if no versioninfo in project
|
|
sz := rsSImportantMe;
|
|
raise Exception.Createfmt(sz, [LineEnding, LineEnding,
|
|
LineEnding, LineEnding, LineEnding]);
|
|
FreeAndNil(fDownloadWrapper);
|
|
FreeAndNil(fShortCutClass);
|
|
Application.Terminate;
|
|
// Eat other Exceptions?
|
|
end;
|
|
finally
|
|
objFileVerInfo.Free;
|
|
end;
|
|
if (fApplicationVersionString = rsNoBuildInfor) then
|
|
fApplicationVersionString := '0.0.0.0';
|
|
|
|
fCopyTree := True; // User can change
|
|
// UpdateList: Redundant?
|
|
AddToUpdateList('', LazUTF8.ParamStrUTF8(0), GetFileVersion, 0);
|
|
fWorkingMode := lauUpdate; // Default
|
|
fProjectType := auSourceForge; // User can change
|
|
fUpdatesFolder := C_UpdatesFolder; // User can change
|
|
fVersionsININame := C_OnlineVersionsININame; // User can change
|
|
fShowUpdateInCaption := False; // User can change
|
|
fShowDialogs := False; // User can change
|
|
fDebugMode := False;
|
|
fFireDebugEvent := False;
|
|
fSilentMode := False;
|
|
|
|
// Propagate down
|
|
fDownloadWrapper.fDebugmode := fDebugMode;
|
|
if ((fProjectType = auSourceForge) or (fProjectType = auGitHubReleaseZip)) then
|
|
fDownloadWrapper.fIsCodeRepository := True
|
|
else
|
|
fDownloadWrapper.fIsCodeRepository := False;
|
|
|
|
fApplicationVersionQuad := StrToVersionQuad(fApplicationVersionString);
|
|
fLastError := C_OK;
|
|
|
|
fVersionCountLimit := 1000000; // default
|
|
fDownloadCountLimit := 10000000; // default
|
|
|
|
|
|
fZipfileName := ''; // assign later
|
|
|
|
// BE SURE TO CHANGE THE CONSTANTS IF YOU CHANGE THE UPDATE EXE NAME
|
|
GetUpdateSilentExe;
|
|
GetUpdateExe;
|
|
|
|
// Assorted versioninfo properties
|
|
fLCLVersion := GetLCLVersion;
|
|
fWidgetSet := GetWidgetSet;
|
|
fFPCVersion := GetCompilerInfo;
|
|
fLastCompiled := GetCompiledDate;
|
|
fTargetOS := GetOS;
|
|
fWindowsAdminCheck := True;
|
|
|
|
|
|
// AboutBox properties
|
|
AboutBoxComponentName := Format('Laz Auto-update v%s',
|
|
[C_TLazAutoUpdateComponentVersion]);
|
|
AboutBoxVersion := C_TLazAutoUpdateComponentVersion;
|
|
AboutBoxWidth := 400;
|
|
AboutBoxHeight := 450;
|
|
sz := 'A component for updating your application' + LineEnding;
|
|
sz += 'Designed for projects hosted by SourceForge and GitHub' +
|
|
LineEnding + LineEnding;
|
|
sz += 'Main methods:' + LineEnding;
|
|
sz += 'Procedure AutoUpdate' + LineEnding;
|
|
sz += 'Function NewVersionAvailable: Boolean' + LineEnding;
|
|
sz += 'Function DownloadNewVersion: Boolean' + LineEnding;
|
|
sz += 'Function UpdateToNewVersion: Boolean' + LineEnding;
|
|
sz += 'Procedure ShowWhatsNewIfAvailable' + LineEnding;
|
|
sz += 'For troubleshooting, set DebugMode=TRUE';
|
|
AboutBoxTitle := 'LazAutoUpdate';
|
|
AboutBoxDescription := sz;
|
|
// AboutBoxBackgroundColor:=clWindow;
|
|
//AboutBoxFontName (string)
|
|
//AboutBoxFontSize (integer)
|
|
AboutBoxAuthorname := 'Gordon Bamber';
|
|
//AboutBoxOrganisation (string)
|
|
AboutBoxAuthorEmail := 'minesadorada@charcodelvalle.com';
|
|
AboutBoxLicenseType := 'MODIFIEDGPL';
|
|
end;
|
|
|
|
destructor TLazAutoUpdate.Destroy;
|
|
begin
|
|
FreeAndNil(fDownloadWrapper);
|
|
FreeAndNil(fShortCutClass);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TLazAutoUpdate.GetUpdateSilentExe: string;
|
|
begin
|
|
fUpdateSilentExe := C_LAUUPDATENAME;
|
|
if csDesigning in ComponentState then
|
|
Result := 'lauupdate'
|
|
else
|
|
Result := fUpdateSilentExe;
|
|
end;
|
|
|
|
function TLazAutoUpdate.GetUpdateExe: string;
|
|
begin
|
|
fUpdateExe := C_UPDATEHMNAME;
|
|
if csDesigning in ComponentState then
|
|
Result := 'updatehm'
|
|
else
|
|
Result := fUpdateExe;
|
|
end;
|
|
|
|
function TLazAutoUpdate.AppIsActive(const ExeName: string): boolean;
|
|
begin
|
|
Result := AppIsRunning(ExeName);
|
|
end;
|
|
|
|
procedure TLazAutoUpdate.ResetAppVersion;
|
|
begin
|
|
fApplicationVersionString := GetFileVersion;
|
|
if (fApplicationVersionString = 'No build information available') then
|
|
fApplicationVersionString := '0.0.0.0';
|
|
fApplicationVersionQuad := StrToVersionQuad(fApplicationVersionString);
|
|
end;
|
|
|
|
procedure TLazAutoUpdate.SetShowDialogs(AValue: boolean);
|
|
begin
|
|
fShowDialogs := AValue;
|
|
if fDownloadWrapper <> nil then
|
|
fDownloadWrapper.fShowDialogs := AValue;
|
|
end;
|
|
|
|
procedure TLazAutoUpdate.SetDebugMode(AValue: boolean);
|
|
begin
|
|
fDebugMode := AValue;
|
|
// Fire the OnDebugEvent event handler?
|
|
if Assigned(fOndebugEvent) then
|
|
fFireDebugEvent := fDebugMode;
|
|
if fDownloadWrapper <> nil then
|
|
fDownloadWrapper.fDebugMode := AValue;
|
|
end;
|
|
|
|
procedure TLazAutoUpdate.SetauOtherSourceURL(AValue: string);
|
|
// Must end in '/'
|
|
begin
|
|
if ((AValue <> fauOtherSourceURL) and (AValue <> '')) then
|
|
begin
|
|
if not AnsiEndsStr('/', AValue) then
|
|
AValue += '/';
|
|
fauOtherSourceURL := AValue;
|
|
end;
|
|
end;
|
|
|
|
procedure TLazAutoUpdate.SetauOtherSourceFilename(AValue: string);
|
|
begin
|
|
if ((AValue <> fauOtherSourceFilename) and (AValue <> '')) then
|
|
begin
|
|
try
|
|
fauOtherSourceFilename := ExtractFileName(AValue);
|
|
except
|
|
ShowMessage(C_NotProperFileName);
|
|
end;
|
|
end;
|
|
end;
|
|
// A couple of public functions for installer apps
|
|
function TLazAutoUpdate.MakeShortCut: boolean;
|
|
begin
|
|
Result := False; // assume failure, look for success
|
|
if Assigned(fOndebugEvent) then
|
|
fFireDebugEvent := True;
|
|
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'MakeShortCut', 'MakeShortCut called');
|
|
|
|
if fShortCutClass.Target = '' then
|
|
fShortCutClass.Target := fAppFilename;
|
|
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'MakeShortCut', Format('Target=%s, TargetArguments=%s',
|
|
[fShortCutClass.Target, fShortCutClass.TargetArguments]));
|
|
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'MakeShortCut',
|
|
Format('Shortcut Name=%s, IconFileName=%s',
|
|
[fShortCutClass.ShortcutName, fShortCutClass.IconFileName]));
|
|
{$IFDEF LINUX}
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'MakeShortCut', Format('Category=%s',
|
|
[fShortCutClass.CategoryString]));
|
|
{$ENDIF}
|
|
Result := CreateDesktopShortCut(fShortCutClass.Target,
|
|
fShortCutClass.TargetArguments, fShortCutClass.ShortcutName,
|
|
fShortCutClass.IconFileName, fShortCutClass.CategoryString);
|
|
fLastError := GetShortCutDebugString;
|
|
if fFireDebugEvent then
|
|
if Result = True then
|
|
fOndebugEvent(Self, 'MakeShortCut', 'MakeShortCut succeded.' +
|
|
GetShortCutDebugString)
|
|
else
|
|
fOndebugEvent(Self, 'MakeShortCut', 'MakeShortCut failed. Error(s): ' +
|
|
GetShortCutDebugString);
|
|
end;
|
|
|
|
function TLazAutoUpdate.DeleteShortCut: boolean;
|
|
begin
|
|
Result := False; // assume failure, look for success
|
|
if Assigned(fOndebugEvent) then
|
|
fFireDebugEvent := True;
|
|
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DeleteShortCut',
|
|
Format('DeleteShortCut called. Shortcut name=%s', [fShortCutClass.ShortcutName]));
|
|
if fShortCutClass.ShortcutName = '' then
|
|
begin
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DeleteShortCut', 'ShortCut.ShortCutName was empty!');
|
|
Exit;
|
|
end;
|
|
Result := DeleteDesktopShortcut(fShortCutClass.ShortCutName);
|
|
|
|
if fFireDebugEvent then
|
|
if Result = True then
|
|
fOndebugEvent(Self, 'MakeShortCut', 'DeleteShortCut succeded.' +
|
|
GetShortCutDebugString)
|
|
else
|
|
fOndebugEvent(Self, 'MakeShortCut', 'DeleteShortCut failed. Error: ' +
|
|
GetShortCutDebugString);
|
|
|
|
end;
|
|
|
|
procedure TLazAutoUpdate.ShowWhatsNewIfAvailable;
|
|
begin
|
|
// Should be called on form.activate
|
|
// Afer an update, the 'whatsnew.txt' is copied into the application's folder
|
|
// This routine shows it, then deletes it
|
|
// If it isn't there, then it exits early
|
|
|
|
// read the VMT once
|
|
if Assigned(fOndebugEvent) then
|
|
fFireDebugEvent := True;
|
|
|
|
if not FileExistsUTF8(ProgramDirectory + C_WhatsNewFilename) then
|
|
begin
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'ShowWhatsNewIfAvailable', 'Unable to locate ' +
|
|
C_WhatsNewFilename);
|
|
Exit;
|
|
end;
|
|
// Linux fix
|
|
if DirectoryExistsUTF8(C_WhatsNewFilename) then
|
|
begin
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'ShowWhatsNewIfAvailable', 'Found directory ' +
|
|
C_WhatsNewFilename);
|
|
if RemoveDirUTF8(C_WhatsNewFilename) then
|
|
begin
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'ShowWhatsNewIfAvailable', 'Deleted directory ' +
|
|
C_WhatsNewFilename);
|
|
end;
|
|
Exit;
|
|
end;
|
|
|
|
// Create the form, memo and close button
|
|
if fParentForm <> nil then
|
|
WhatsNewForm := TForm.CreateNew(fParentForm)
|
|
else
|
|
WhatsNewForm := TForm.CreateNew(fParentApplication);
|
|
|
|
WhatsNewMemo := TMemo.Create(WhatsNewForm);
|
|
cmdClose := TBitBtn.Create(WhatsNewForm);
|
|
|
|
try // ..finally destroy all
|
|
with WhatsNewForm do
|
|
begin
|
|
Height := 480;
|
|
Width := 640;
|
|
// BorderStyle:=bsToolWindow;
|
|
Caption := Format(C_WhatsNewInVersion, [GetFileVersion]);
|
|
DefaultMonitor := dmActiveForm;
|
|
// FormStyle:=fsStayOnTop;
|
|
Position := poScreenCenter;
|
|
ShowInTaskBar := stNever;
|
|
end;
|
|
with WhatsNewMemo do
|
|
begin
|
|
Height := WhatsNewForm.Height - 80;
|
|
Width := WhatsNewForm.ClientWidth;
|
|
ReadOnly := True;
|
|
ScrollBars := ssAutoBoth;
|
|
WordWrap := True;
|
|
Parent := WhatsNewForm;
|
|
try
|
|
Lines.LoadFromFile(ProgramDirectory + C_WhatsNewFilename);
|
|
except
|
|
Clear;
|
|
Lines.Add('Unable to show whats new');
|
|
end;
|
|
end;
|
|
with cmdClose do
|
|
begin
|
|
Top := WhatsNewForm.Height - Height - 20;
|
|
Left := (WhatsNewForm.Width div 2) - (Width div 2);
|
|
Kind := bkClose;
|
|
Parent := WhatsNewForm;
|
|
end;
|
|
// Show the window modally (cmdClose will close it)
|
|
WhatsNewForm.ShowModal;
|
|
try
|
|
// Delete the whatsnew.txt now the user has seen it
|
|
if not SysUtils.DeleteFile(ProgramDirectory + C_WhatsNewFilename) then
|
|
if fShowDialogs then
|
|
ShowMessageFmt(C_UnableToDelete,
|
|
[C_WhatsNewFilename, LineEnding]);
|
|
except
|
|
// Ignore Exceptions
|
|
end;
|
|
finally
|
|
{
|
|
cmdClose.Free; // Not needed
|
|
WhatsNewMemo.Free; // Not needed
|
|
}
|
|
FreeAndNil(WhatsNewForm); // Free the form and its minions
|
|
end;
|
|
end;
|
|
|
|
function TLazAutoUpdate.SilentUpdate: boolean;
|
|
// Part of the tray update system
|
|
begin
|
|
// read the VMT once
|
|
if Assigned(fOndebugEvent) then
|
|
fFireDebugEvent := True;
|
|
|
|
Result := False;
|
|
fSilentMode := True;
|
|
fShowUpdateInCaption := False;
|
|
fShowDialogs := False;
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'SilentUpdate', 'Calling UpdateToNewVersion');
|
|
|
|
// Use the local lauupdate if available
|
|
if FileExistsUTF8(ProgramDirectory + C_LAUUPDATENAME) then
|
|
begin
|
|
if RemoteUpdateToNewVersion then
|
|
// If IsAppRunning=FALSE, then calls DoSilentUpdate
|
|
begin
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'SilentUpdate', 'UpdateToNewVersion succeeded');
|
|
fSilentMode := False;
|
|
Result := True;
|
|
end;
|
|
|
|
end
|
|
else
|
|
begin
|
|
if UpdateToNewVersion then
|
|
// If IsAppRunning=FALSE, then calls DoSilentUpdate
|
|
begin
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'SilentUpdate', 'UpdateToNewVersion succeeded');
|
|
fSilentMode := False;
|
|
Result := True;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TLazAutoUpdate.AutoUpdate: boolean;
|
|
// Do-all proc that user can drop into a menu
|
|
begin
|
|
if Assigned(fOndebugEvent) then
|
|
fFireDebugEvent := True;
|
|
Result := False;
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'AutoUpdate', 'Calling NewVersionAvailable');
|
|
if NewVersionAvailable then
|
|
begin
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'AutoUpdate', 'NewVersionAvailable succeeded');
|
|
|
|
if MessageDlg(fParentApplication.Title, Format(rsANewVersionS,
|
|
[fGUIOnlineVersion]), mtConfirmation, [mbYes, mbNo], 0, mbYes) = 6 then
|
|
begin
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'AutoUpdate', 'Calling DownloadNewVersion');
|
|
|
|
if DownloadNewVersion then
|
|
begin
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'AutoUpdate', 'DownloadNewVersion suceeded');
|
|
if MessageDlg(fParentApplication.Title,
|
|
Format(rsVewVersionSH, [fGUIOnlineVersion]), mtConfirmation,
|
|
[mbOK, mbCancel], 0, mbOK) = 1 then
|
|
begin
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'AutoUpdate', 'Calling UpdateToNewVersion');
|
|
UpdateToNewVersion;
|
|
end
|
|
else
|
|
MessageDlg(fParentApplication.Title,
|
|
rsCancelledYou,
|
|
mtInformation, [mbOK], 0);
|
|
end
|
|
else
|
|
MessageDlg(fParentApplication.Title,
|
|
Format(rsDownloadFail, [GetThreadDownloadReturnCode]),
|
|
mtInformation, [mbOK], 0);
|
|
end
|
|
else
|
|
MessageDlg(fParentApplication.Title,
|
|
rsCancelledYou2,
|
|
mtInformation, [mbOK], 0);
|
|
end
|
|
else
|
|
begin
|
|
MessageDlg(fParentApplication.Title,
|
|
rsThisApplicat,
|
|
mtInformation, [mbOK], 0);
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
function TLazAutoUpdate.IsOnlineVersionNewer(const sznewINIPath: string): boolean;
|
|
// Compares version contained in szTempXMLPath INI file
|
|
// to fApplicationVersionNumber
|
|
var
|
|
VersionINI: TIniFile;
|
|
{
|
|
C_INISection = 'versions';
|
|
C_GUIEntry ='GUI';
|
|
C_ModuleEntry = 'Module';
|
|
}
|
|
begin
|
|
// read the VMT once
|
|
if Assigned(fOndebugEvent) then
|
|
fFireDebugEvent := True;
|
|
|
|
Result := False;
|
|
VersionINI := TIniFile.Create(sznewINIPath);
|
|
try
|
|
fGUIOnlineVersion := VersionINI.ReadString(C_INISection, C_GUIEntry, '0.0.0.0');
|
|
if not TryStrToVersionQuad(fGUIOnlineVersion, fGuiQuad) then
|
|
fGUIQuad := StrToVersionQuad('0.0.0.0');
|
|
finally
|
|
VersionINI.Free;
|
|
end;
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'IsOnlineVersionNewer',
|
|
Format('fGUIOnlineVersion=%s, fApplicationVersionString=%s, szTempXMLPath=%s',
|
|
[fGUIOnlineVersion, fApplicationVersionString, sznewINIPath]));
|
|
|
|
// Fetch the 4 (or less) version elements and make into an Integer
|
|
// so 1.10 > 1.9.9.9
|
|
// iGUIVersion := VersionStringToNumber(fGUIOnlineVersion);
|
|
// Test: Is the online version newer?
|
|
if NewerVersion(fGUIQuad, fApplicationVersionQuad) then
|
|
Result := True;
|
|
end;
|
|
|
|
|
|
function TLazAutoUpdate.NewVersionAvailable: boolean;
|
|
// Returns TRUE is a new version is available
|
|
var
|
|
szURL, szTargetPath: string;
|
|
cCount: cardinal;
|
|
szOldCaption: string;
|
|
begin
|
|
Result := False;
|
|
// read the VMT once
|
|
if Assigned(fOndebugEvent) then
|
|
fFireDebugEvent := True;
|
|
|
|
if fZipFileName = '' then
|
|
begin
|
|
fZipfileName := ChangeFileExt(ExtractFilename(fAppFilename), '.zip');
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'NewVersionAvailable',
|
|
Format('Assigning ZipFile name %s', [fZipfileName]));
|
|
end;
|
|
|
|
if fProjectType = auSourceForge then
|
|
begin
|
|
if fSourceForgeProjectName = '' then
|
|
begin
|
|
if fShowDialogs then
|
|
ShowMessage(C_PropIsEmpty);
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'NewVersionAvailable (auSourceForge)', C_PropIsEmpty);
|
|
Exit;
|
|
end;
|
|
szURL := Format(C_SOURCEFORGEURL, [fSourceForgeProjectName,
|
|
fUpdatesFolder, fVersionsININame]);
|
|
end;
|
|
|
|
if fProjectType = auGitHubReleaseZip then
|
|
begin
|
|
if ((fGitHubProjectName = '') or (fGitHubRepositoryName = '')) then
|
|
begin
|
|
if fShowDialogs then
|
|
ShowMessage(C_PropIsEmpty);
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'NewVersionAvailable (auGitHubReleaseZip)', C_PropIsEmpty);
|
|
Exit;
|
|
end;
|
|
if ((fUpdatesFolder = C_NotApplicable) or (fUpdatesFolder = '')) then
|
|
szURL := Format(C_GITHUBFILE_URL, [fGitHubProjectName,
|
|
fGitHubRepositoryName, fGitHubBranchOrTag, fVersionsININame])
|
|
else
|
|
szURL := Format(C_GITHUBFILE_URL_UPDATES,
|
|
[fGitHubProjectName, fGitHubRepositoryName, fGitHubBranchOrTag,
|
|
fUpdatesFolder, fVersionsININame]);
|
|
end;
|
|
|
|
if fProjectType = auOther then
|
|
// fauOtherSourceURL ends with '/'
|
|
begin
|
|
szURL := fauOtherSourceURL + fVersionsININame;
|
|
end;
|
|
|
|
|
|
szTargetPath := AppendPathDelim(ExtractFilePath(fAppFilename)) +
|
|
Format(C_TempVersionsININame, [fVersionsININame]);
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'NewVersionAvailable',
|
|
Format('URL is %s', [szURL]));
|
|
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'NewVersionAvailable',
|
|
Format('Target Path %s', [szTargetPath]));
|
|
|
|
|
|
// Delete any old versions
|
|
try
|
|
if FileExistsUTF8(szTargetPath) then
|
|
begin
|
|
SysUtils.DeleteFile(szTargetPath);
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'NewVersionAvailable',
|
|
Format('Deleted old file %s', [szTargetPath]));
|
|
end;
|
|
except
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'NewVersionAvailable',
|
|
Format('Failed to delete old file %s', [szTargetPath]));
|
|
// No error if the delete can't be done
|
|
end;
|
|
with fDownloadWrapper do
|
|
begin
|
|
URL := szURL;
|
|
Filename := szTargetPath;
|
|
if not fSilentMode then
|
|
szOldCaption := fParentForm.Caption;
|
|
// Initialise fields
|
|
ThreadFinished := False;
|
|
ReturnCode := 0;
|
|
DownloadSize := 0;
|
|
fDownloadInprogress := True;
|
|
DebugMode := fDebugMode;
|
|
if not fSilentMode then
|
|
fParentForm.Caption := C_Checking;
|
|
CheckForOpenSSL;
|
|
// Start the thread
|
|
ThreadDownloadHTTP;
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'NewVersionAvailable',
|
|
Format('ThreadDownloadHTTP return Code was %d', [fReturnCode]));
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'NewVersionAvailable',
|
|
Format('ThreadDownloadHTTP Last Error was %s', [fLastError]));
|
|
|
|
cCount := 0;
|
|
// Update the GUI during the thread
|
|
try
|
|
while (ThreadFinished = False) do
|
|
begin
|
|
Inc(cCount);
|
|
Sleep(1);
|
|
fParentApplication.ProcessMessages;
|
|
ThreadSwitch();
|
|
{$IFDEF WINDOWS}
|
|
if fShowUpdateInCaption then
|
|
fParentForm.Caption := Format(C_Checking + ' %d', [cCount])
|
|
else
|
|
Sleep(10);
|
|
{$ENDIF}
|
|
fParentApplication.ProcessMessages;
|
|
if (cCount > fVersionCountLimit) then
|
|
begin
|
|
if fShowDialogs then
|
|
ShowMessage(C_TakingTooLong);
|
|
ThreadFinished := True;
|
|
fDownloadSize := 0;
|
|
fDownloadInprogress := False;
|
|
if not fSilentMode then
|
|
fParentForm.Caption := szOldCaption;
|
|
Exit;
|
|
end;
|
|
end;
|
|
except
|
|
ThreadFinished := True;
|
|
fDownloadSize := 0;
|
|
fDownloadInprogress := False;
|
|
if not fSilentMode then
|
|
fParentForm.Caption := szOldCaption;
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'NewVersionAvailable',
|
|
C_ThreadDownloadCrash);
|
|
Exit;
|
|
end;
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'NewVersionAvailable',
|
|
Format('After Threadfinished: Return Code was %d', [fReturnCode]));
|
|
Sleep(1);
|
|
fDownloadInprogress := False;
|
|
if fDownloadSize > 0 then
|
|
begin
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'NewVersionAvailable',
|
|
Format('Downloaded %s OK', [szTargetPath]));
|
|
fParentApplication.ProcessMessages;
|
|
Result := IsOnlineVersionNewer(szTargetPath);
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'NewVersionAvailable',
|
|
Format(C_DownloadedBytes, [szTargetPath, fDownloadSize]));
|
|
end
|
|
else
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'NewVersionAvailable',
|
|
Format('DownloadSize was %d', [fDownloadSize]));
|
|
|
|
end;
|
|
if not fSilentMode then
|
|
fParentForm.Caption := szOldCaption;
|
|
if Assigned(fOnNewVersionAvailable) then
|
|
fOnNewVersionAvailable(Self, Result, fGUIOnlineVersion);
|
|
end;
|
|
|
|
function TLazAutoUpdate.DownloadNewVersion: boolean;
|
|
// Returns TRUE is download succeeded
|
|
// If FALSE. then examine ReturnCode property
|
|
var
|
|
szURL, szTargetPath, szUpdatesFolder: string;
|
|
cCount: cardinal;
|
|
szOldCaption: string;
|
|
iDownloadedSize: integer;
|
|
FileStringList: TStringList;
|
|
iCount: integer;
|
|
begin
|
|
Result := False;
|
|
// read the VMT once
|
|
if Assigned(fOndebugEvent) then
|
|
fFireDebugEvent := True;
|
|
|
|
// **************
|
|
// **************
|
|
iDownloadedSize := 0;
|
|
if fZipFileName = '' then
|
|
begin
|
|
fZipfileName := ChangeFileExt(ExtractFilename(fAppFilename), '.zip');
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DownloadNewVersion',
|
|
Format('ZipFilename was empty. Assigned %s', [fZipfileName]));
|
|
end;
|
|
szTargetPath := fZipfileName;
|
|
if fProjectType = auSourceForge then
|
|
szURL := Format(C_SOURCEFORGEURL, [fSourceForgeProjectName,
|
|
fUpdatesFolder, ExtractFileName(szTargetPath)]);
|
|
if fProjectType = auGitHubReleaseZip then
|
|
if ((fUpdatesFolder = C_NotApplicable) or (fUpdatesFolder = '')) then
|
|
szURL := Format(C_GITHUBFILE_URL, [fGitHubProjectName,
|
|
fGitHubRepositoryName, fGitHubBranchOrTag, fZipfileName])
|
|
else
|
|
szURL := Format(C_GITHUBFILE_URL_UPDATES,
|
|
[fGitHubProjectName, fGitHubRepositoryName, fGitHubBranchOrTag,
|
|
fUpdatesFolder, fZipfileName]);
|
|
if fProjectType = auOther then
|
|
// fauOtherSourceURL ends with '/'
|
|
begin
|
|
szURL := fauOtherSourceURL + fVersionsININame;
|
|
end;
|
|
|
|
szUpdatesFolder := AppendPathDelim(ExtractFilePath(fAppFilename)) + fUpdatesFolder;
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DownloadNewVersion',
|
|
Format('Download parameters: TargetPath=%s%sURL=%s%sUpdatesFolder=%s',
|
|
[szTargetPath, LineEnding, szURL, LineEnding, szUpdatesFolder]));
|
|
|
|
|
|
// If updates folder exists, delete previous contents
|
|
// If not, then create updates folder
|
|
try
|
|
if DirPathExists(szUpdatesFolder) then
|
|
begin
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DownloadNewVersion',
|
|
Format('Files already exist in %s. They will be deleted.',
|
|
[szUpdatesFolder]));
|
|
|
|
FileStringList := TStringList.Create;
|
|
try
|
|
FileStringList := FindAllFiles(szUpdatesFolder, '*.*', True);
|
|
try
|
|
for iCount := 0 to FileStringList.Count - 1 do
|
|
SysUtils.DeleteFile(FileStringList[iCount]);
|
|
except
|
|
fLastError := Format(C_UnableToDeleteOld, [szUpdatesFolder]);
|
|
if fDebugMode then
|
|
ShowMessage(fLastError);
|
|
end;
|
|
finally
|
|
FileStringList.Free;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if ForceDirectory(szUpdatesFolder) then
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DownloadNewVersion',
|
|
Format('New directory %s was created', [szUpdatesFolder]));
|
|
end;
|
|
except
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DownloadNewVersion',
|
|
Format(C_DirectoryProblems, [szUpdatesFolder]));
|
|
raise Exception.CreateFmt(C_DirectoryProblems, [szUpdatesFolder]);
|
|
end;
|
|
|
|
// Set target to the updates folder
|
|
szTargetPath := AppendPathDelim(szUpdatesFolder) + ExtractFileName(szTargetPath);
|
|
|
|
if fProjectType = auOther then
|
|
// fauOtherSourceURL ends with PathDelimiter
|
|
begin
|
|
szURL := fauOtherSourceURL + fauOtherSourceFilename;
|
|
szTargetPath := szUpdatesFolder + PathDelim + fauOtherSourceFilename;
|
|
end;
|
|
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DownloadNewVersion',
|
|
Format('szURL=%s, szTargetPath=%s', [szURL, szTargetPath]));
|
|
|
|
// Double-check: Delete any earlier updates?
|
|
try
|
|
if FileExistsUTF8(szTargetPath) then
|
|
begin
|
|
SysUtils.DeleteFile(szTargetPath);
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DownloadNewVersion',
|
|
Format('Deleting old file %s', [szTargetPath]));
|
|
end;
|
|
except
|
|
// Ignore exceptions
|
|
end;
|
|
|
|
fDownloadInprogress := True;
|
|
CheckForOpenSSL;
|
|
|
|
if Assigned(OnFileWriteProgress) then
|
|
begin
|
|
fDownloadWrapper.OnDownloadWrapperFileWriteProgress := OnFileWriteProgress;
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DownloadNewVersion', 'OnProgess assigned OK');
|
|
end;
|
|
|
|
// Do the download
|
|
with fDownloadWrapper do
|
|
begin
|
|
// Initialise fields
|
|
URL := szURL;
|
|
Filename := szTargetPath;
|
|
ThreadFinished := False;
|
|
ReturnCode := 0;
|
|
DownloadSize := 0;
|
|
fUnzipAfter := True;
|
|
DebugMode := fDebugMode;
|
|
if not fSilentMode then
|
|
szOldCaption := fParentForm.Caption;
|
|
if not fSilentMode then
|
|
fParentForm.Caption := C_Downloading;
|
|
// Start the thread
|
|
ThreadDownloadHTTP;
|
|
cCount := 0;
|
|
begin
|
|
// The thread is running....
|
|
cCount := 0;
|
|
try
|
|
while (ThreadFinished = False) do
|
|
begin
|
|
try
|
|
// fDownloadWrapper.fDownLoad.Synchronize(fDownloadWrapper.fDownLoad.GetPercent);
|
|
cCount := fDownloadWrapper.fDownLoad.Percent;
|
|
//threadswitch;
|
|
//fParentApplication.QueueAsyncCall(@fDownloadWrapper.fDownLoad.GetPercent,0);
|
|
// Inc(cCount);
|
|
//CheckSynchronize();
|
|
Sleep(1);
|
|
fParentApplication.ProcessMessages;
|
|
{$IFDEF WINDOWS}
|
|
if fShowUpdateInCaption then
|
|
begin
|
|
fParentForm.Caption := Format(C_Downloading + ' %d', [cCount]);
|
|
fParentApplication.ProcessMessages;
|
|
end
|
|
else
|
|
sleep(10);
|
|
fParentApplication.ProcessMessages; // Keep GUI responsive
|
|
if (cCount > fDownloadCountLimit) then // Download taking too long?
|
|
begin
|
|
fDownloadInprogress := False;
|
|
if not fSilentMode then
|
|
fParentForm.Caption := szOldCaption;
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DownloadNewVersion', C_TakingTooLong);
|
|
ThreadFinished := True;
|
|
fDownloadSize := 0;
|
|
Exit;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
finally
|
|
end;
|
|
end;
|
|
iDownloadedSize := fDownloadSize;
|
|
|
|
except
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DownloadNewVersion', C_ThreadDownloadHTTPCrash);
|
|
end;
|
|
fDownloadInprogress := False;
|
|
Sleep(1);
|
|
// We have the HTTP return code in MyThreadDownload.ReturnCode. Normal=200
|
|
if (ReturnCode <> 0) and (ReturnCode < 400) then
|
|
begin
|
|
// Success! New version is unzipped and ready in the /updates folder
|
|
// Shell into the updater app here
|
|
// 1) Closes this app
|
|
// 2) Copies the szUpdateFolder/downloadedexe to the .exe
|
|
// 3) Restarts this (updated) app (showing C_WhatsNewFilename?)
|
|
Result := (fDownloadSize > 0);
|
|
if fFireDebugEvent then
|
|
begin
|
|
fOndebugEvent(Self, 'DownloadNewVersion',
|
|
Format(C_DownloadedBytes, [ExtractFilename(szTargetPath),
|
|
fDownloadSize]));
|
|
fOndebugEvent(Self, 'DownloadNewVersion',
|
|
Format(C_DownloadSuccess, [fGUIOnlineVersion]));
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
Result := False;
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DownloadNewVersion',
|
|
Format(C_UnableToDownload, [LineEnding, ReturnCode]));
|
|
Free;
|
|
end;
|
|
end;
|
|
end;
|
|
// Fire the event?
|
|
if not fSilentMode then
|
|
fParentForm.Caption := C_PleaseWaitProcessing;
|
|
if Assigned(fOnDownloaded) then
|
|
fOnDownloaded(Self, ReturnCode, iDownloadedSize);
|
|
if not fSilentMode then
|
|
fParentForm.Caption := szOldCaption;
|
|
end;
|
|
|
|
function UTF8StringReplace(const S, OldPattern, NewPattern: string;
|
|
Flags: TReplaceFlags): string;
|
|
var
|
|
uS, uOld: string;
|
|
// Warning! Always changes string to UPPERCASE
|
|
begin
|
|
if rfIgnoreCase in Flags then
|
|
begin
|
|
uS := LazUTF8.UTF8UpperCase(S);
|
|
uOld := LazUTF8.UTF8UpperCase(OldPattern);
|
|
Flags := Flags - [rfIgnoreCase]; //no point uppercasing again
|
|
Result := StringReplace(uS, uOld, NewPattern, Flags);
|
|
end
|
|
else
|
|
Result := StringReplace(S, OldPattern, NewPattern, Flags);
|
|
end;
|
|
|
|
function TLazAutoUpdate.CreateLocalLauImportFile: boolean;
|
|
// Used in SysTray app
|
|
var
|
|
LAUTRayINI: TIniFile;
|
|
szSection: string;
|
|
szSuffix: string;
|
|
begin
|
|
// read the VMT once
|
|
if Assigned(fOndebugEvent) then
|
|
fFireDebugEvent := True;
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'CreateLocalLauImportFile', 'CreateLocalLauImportFile called');
|
|
//
|
|
if (ProgramDirectory + C_LAUTRayINI <> '') then
|
|
begin
|
|
RelocateLauImportFile;
|
|
Result := True;
|
|
Exit;
|
|
end;
|
|
// Make up OS-Bitness suffix
|
|
{$IFDEF WINDOWS}
|
|
szSuffix := 'win';
|
|
{$ELSE}
|
|
szSuffix := 'linux';
|
|
{$ENDIF}
|
|
{$IFDEF CPU64}
|
|
szSuffix += '64';
|
|
{$ELSE}
|
|
szSuffix += '32';
|
|
{$ENDIF}
|
|
Result := False;
|
|
LAUTRayINI := TIniFile.Create(GetAppConfigDirUTF8(False, True) + C_LAUTRayINI);
|
|
try
|
|
with LAUTRayINI do
|
|
begin
|
|
if fParentApplication <> nil then
|
|
szSection := fParentApplication.Title
|
|
else
|
|
if fParentForm <> nil then
|
|
szSection := fParentForm.Caption
|
|
else
|
|
szSection := 'My Application';
|
|
if ((AnsiContainsText(szSection,
|
|
{$I %FPCTARGETOS%}
|
|
) = False) and (AnsiContainsText(szSection, szSuffix) = False)) then
|
|
szSection += szSuffix;
|
|
WriteString(szSection, 'AppPrettyName', szSection);
|
|
WriteString(szSection, 'AppPath', ExtractFilename(fAppFilename));
|
|
WriteString(szSection, 'INIPath', fVersionsININame);
|
|
WriteString(szSection, 'ZipPath', fZipfileName);
|
|
WriteString(szSection, 'AppVersion', fApplicationVersionString);
|
|
WriteString(szSection, 'SFProjectName', fSourceForgeProjectName);
|
|
WriteString(szSection, 'SFUpdatesDirectory', fUpdatesFolder);
|
|
WriteString(szSection, 'Location', ExtractFilePath(fAppFilename));
|
|
//Suggest a schedule
|
|
WriteInteger(szSection, 'IntervalType', 0);
|
|
WriteInteger(szSection, 'IntervalDay', 0);
|
|
WriteInteger(szSection, 'IntervalDate', 1);
|
|
WriteInteger(szSection, 'IntervalHour', 9);
|
|
WriteInteger(szSection, 'Update', 0);
|
|
WriteString(szSection, 'LastCheckDateTime', '2000-01-01 00-00');
|
|
UpdateFile;
|
|
Result := True;
|
|
end;
|
|
finally
|
|
FreeAndNil(LAUTRayINI);
|
|
end;
|
|
end;
|
|
|
|
procedure TLazAutoUpdate.RelocateLauImportFile;
|
|
// If C_LAUTRayINI is found in the App Folder, it is moved to the <LocalAppData>/updatehm folder
|
|
var
|
|
szSourceLAUTrayPath, szDestLAUTrayPath, szDestLAUTrayDirectory: string;
|
|
begin
|
|
// read the VMT once
|
|
if Assigned(fOndebugEvent) then
|
|
fFireDebugEvent := True;
|
|
szSourceLAUTrayPath := ExtractFilePath(fAppFilename) + C_LAUTRayINI;
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'RelocateLauImportFile',
|
|
Format('Looking for %s.', [szSourceLAUTrayPath]));
|
|
|
|
if FileExists(szSourceLAUTrayPath) then
|
|
begin
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'RelocateLauImportFile',
|
|
Format('Found %s.', [szSourceLAUTrayPath]));
|
|
// Make up local <AppData>/updatehm/C_LAUTRayINI path
|
|
szDestLAUTrayPath := GetAppConfigDirUTF8(False, False); // Don't create it yet
|
|
{$IFDEF WINDOWS}
|
|
szDestLAUTrayPath := StringReplace(szDestLAUTrayPath, Application.Title,
|
|
'updatehm' + C_PFX, [rfReplaceAll]);
|
|
{$ELSE}
|
|
szDestLAUTrayPath := UTF8StringReplace(szDestLAUTrayPath,
|
|
Application.Title, 'updatehm' + C_PFX, [rfReplaceAll]);
|
|
{$ENDIF}
|
|
end
|
|
else
|
|
Exit; // Nothing to do
|
|
// szDestLAUTrayPath := LowerCase(szDestLAUTrayPath);
|
|
szDestLAUTrayDirectory := ExtractFilePath(szDestLAUTrayPath);
|
|
|
|
if DirectoryExistsUTF8(szDestLAUTrayDirectory) then
|
|
begin
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'RelocateLauImportFile',
|
|
Format('%s already exists.', [szDestLAUTrayDirectory]));
|
|
end
|
|
else
|
|
begin
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'RelocateLauImportFile',
|
|
Format('%s does not previously exist.', [szDestLAUTrayDirectory]));
|
|
if ForceDirectory(szDestLAUTrayDirectory) then
|
|
begin
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'RelocateLauImportFile',
|
|
Format('Created folder %s.', [szDestLAUTrayDirectory]));
|
|
end
|
|
else
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'RelocateLauImportFile',
|
|
Format('Unable to create folder %s.', [szDestLAUTrayDirectory]));
|
|
end;
|
|
|
|
// Don't copy over an existing file
|
|
if not FileExists(szDestLAUTrayPath + C_LAUTRayINI) then
|
|
begin
|
|
// Move C_LAUTRayINI from app folder to local <AppData> folder
|
|
if FileUtil.CopyFile(szSourceLAUTrayPath, szDestLAUTrayPath +
|
|
C_LAUTRayINI, [cffOverwriteFile]) then
|
|
begin
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'RelocateLauImportFile',
|
|
Format('Relocated %s from %s to %s', [C_LAUTRayINI,
|
|
szSourceLAUTrayPath, szDestLAUTrayPath]));
|
|
SysUtils.DeleteFile(szSourceLAUTrayPath);
|
|
end
|
|
else
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'RelocateLauImportFile',
|
|
Format('Failed to relocate %s from %s to %s',
|
|
[C_LAUTRayINI, szSourceLAUTrayPath, szDestLAUTrayPath]));
|
|
end;
|
|
end;
|
|
|
|
function TLazAutoUpdate.DoSilentUpdate: boolean;
|
|
// Used in Systray app
|
|
// Called from UpdateToNewVersion when the app is not running
|
|
// Updates the app, and also copies over and updates C_LAUTRayINI
|
|
var
|
|
szAppFolder: string;
|
|
szLAUTrayAppPath: string;
|
|
INI: TINIFile;
|
|
SectionStringList: TStrings;
|
|
szTempUpdatesFolder: string;
|
|
ErrMsg: string;
|
|
begin
|
|
// fWorkingMode=lauInstall or lauUpdate
|
|
Result := False;
|
|
// read the VMT once
|
|
if Assigned(fOndebugEvent) then
|
|
fFireDebugEvent := True;
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DoSilentUpdate', 'Starting DoSilentUpdate');
|
|
|
|
if fFireDebugEvent then
|
|
if fWorkingMode = lauUpdate then
|
|
fOndebugEvent(Self, 'DoSilentUpdate', 'Update mode')
|
|
else
|
|
fOndebugEvent(Self, 'DoSilentUpdate', 'Install mode');
|
|
|
|
if fWorkingMode = lauUpdate then
|
|
begin
|
|
if not FileExists(fAppFilename) then
|
|
begin
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DoSilentUpdate',
|
|
Format('AppFilename %s is missing. Exiting routine', [fAppFilename]));
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
// uses fUpdatesFolder
|
|
szTempUpdatesFolder := AppendPathDelim(ExtractFilePath(fAppFilename) + fUpdatesFolder);
|
|
|
|
if not DirectoryExistsUTF8(szTempUpdatesFolder) then
|
|
begin
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DoSilentUpdate',
|
|
Format('Updates folder %s was missing.', [szTempUpdatesFolder]));
|
|
if ForceDirectory(szTempUpdatesFolder) then
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DoSilentUpdate',
|
|
Format('Created folder %s.', [szTempUpdatesFolder]));
|
|
end;
|
|
|
|
szAppFolder := AppendPathDelim(ExtractFilePath(fAppFilename));
|
|
// Copy over everything from the updates folder
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DoSilentUpdate',
|
|
Format('About to copy from %s to %s', [szTempUpdatesFolder, szAppFolder]));
|
|
|
|
if fCopyTree then
|
|
begin
|
|
if CopyDirTree(szTempUpdatesFolder, szAppFolder,
|
|
[cffOverwriteFile, cffCreateDestDirectory]) then
|
|
begin
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DoSilentUpdate',
|
|
Format('CopyTree successful from %s to %s',
|
|
[szTempUpdatesFolder, szAppFolder]));
|
|
end
|
|
else
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DoSilentUpdate',
|
|
Format('Error: CopyTree unsuccessful from %s to %s',
|
|
[szTempUpdatesFolder, szAppFolder]));
|
|
end
|
|
else
|
|
begin
|
|
// Copy over app
|
|
if FileUtil.CopyFile(szTempUpdatesFolder + ExtractFileName(fAppFilename),
|
|
szAppFolder + ExtractFileName(fAppFilename), [cffOverwriteFile]) then
|
|
begin
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DoSilentUpdate',
|
|
Format('Copied app from %s to %s', [szTempUpdatesFolder +
|
|
ExtractFileName(fAppFilename), szAppFolder + ExtractFileName(fAppFilename)]));
|
|
|
|
{$IFDEF LINUX}
|
|
if not SetExecutePermission(szAppFolder + ExtractFileName(fAppFilename),
|
|
ErrMsg) then
|
|
begin
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DoSilentUpdate',
|
|
Format('Unable to set permissions for %s because of %s',
|
|
[szAppFolder + ExtractFileName(fAppFilename), ErrMsg]));
|
|
if fShowDialogs then
|
|
ShowMessageFmt('Unable to set permissions for %s because of %s',
|
|
[szAppFolder + ExtractFileName(fAppFilename), ErrMsg]);
|
|
end;
|
|
{$ENDIF}
|
|
end
|
|
else
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DoSilentUpdate',
|
|
Format('Failed to copy app from %s to %s',
|
|
[szTempUpdatesFolder + ExtractFileName(fAppFilename),
|
|
szAppFolder + ExtractFileName(fAppFilename)]));
|
|
|
|
// Copy over WhatsNew
|
|
if FileUtil.CopyFile(szTempUpdatesFolder + 'whatsnew.txt',
|
|
szAppFolder + 'whatsnew.txt', [cffOverwriteFile]) then
|
|
begin
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DoSilentUpdate',
|
|
Format('Copied whatsnew.txt from %s to %s',
|
|
[szTempUpdatesFolder + 'whatsnew.txt', szAppFolder + 'whatsnew.txt']));
|
|
end
|
|
else
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DoSilentUpdate',
|
|
Format('Failed to copy whatsnew.txt from %s to %s',
|
|
[szTempUpdatesFolder + 'whatsnew.txt', szAppFolder + 'whatsnew.txt']));
|
|
|
|
end;
|
|
|
|
if (fWorkingMode = lauInstall) then
|
|
if FileExists(C_UPDATEHMNAME) then
|
|
begin
|
|
if FileUtil.CopyFile(C_UPDATEHMNAME, szAppFolder + C_UPDATEHMNAME) then
|
|
begin
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DoSilentUpdate',
|
|
Format('Sucessfully copied %s to %s',
|
|
[C_UPDATEHMNAME, szAppFolder]));
|
|
{$IFDEF LINUX}
|
|
if not SetExecutePermission(szAppFolder + C_UPDATEHMNAME, ErrMsg) then
|
|
begin
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DoSilentUpdate',
|
|
Format('Unable to set permissions for %s because of %s',
|
|
[szAppFolder + C_UPDATEHMNAME, ErrMsg]));
|
|
if fShowDialogs then
|
|
ShowMessageFmt('Unable to set permissions for %s because of %s',
|
|
[szAppFolder + C_UPDATEHMNAME, ErrMsg]);
|
|
end;
|
|
{$ENDIF}
|
|
end
|
|
else
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DoSilentUpdate',
|
|
Format('Unabled to copy %s to %s', [C_UPDATEHMNAME, szAppFolder]));
|
|
|
|
end
|
|
else
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DoSilentUpdate', 'Unable to locate ' + C_UPDATEHMNAME);
|
|
|
|
|
|
|
|
// Deal with C_LAUTRayINI
|
|
// Copied to the global application data folder
|
|
// Add entry 'Location'
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DoSilentUpdate', 'About to process ' +
|
|
szTempUpdatesFolder + C_LAUTRayINI);
|
|
|
|
if FileExists(szTempUpdatesFolder + C_LAUTRayINI) then
|
|
begin
|
|
szLAUTrayAppPath := GetAppConfigDirUTF8(False, True); // Create it if necessary
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DoSilentUpdate',
|
|
Format('App data directory is %s', [szLAUTrayAppPath]));
|
|
// AppDataDirectory/LazAutoUpdater/
|
|
szLAUTrayAppPath := UTF8StringReplace(szLAUTrayAppPath, Application.Title,
|
|
'updatehm' + C_PFX, [rfIgnoreCase, rfReplaceAll]);
|
|
szLAUTrayAppPath := LowerCase(szLAUTrayAppPath);
|
|
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DoSilentUpdate',
|
|
Format('App data directory changed to %s', [szLAUTrayAppPath]));
|
|
|
|
// Now AppDataDirectory/updatehm(+C_PFX)/
|
|
try
|
|
if ForceDirectory(szLAUTrayAppPath) then
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DoSilentUpdate',
|
|
Format('Made directory %s', [szLAUTrayAppPath]));
|
|
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DoSilentUpdate',
|
|
Format('About to copy %s to %s', [szTempUpdatesFolder +
|
|
C_LAUTRayINI, szLAUTrayAppPath]));
|
|
|
|
Fileutil.CopyFile(szTempUpdatesFolder + C_LAUTRayINI, szLAUTrayAppPath +
|
|
C_LAUTRayINI, [cffOverWriteFile]);
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DoSilentUpdate',
|
|
Format('Successfully copied %s to %s ',
|
|
[C_LAUTRayINI, szLAUTrayAppPath]));
|
|
|
|
if FileExists(szLAUTrayAppPath + C_LAUTRayINI) then
|
|
begin
|
|
INI := TINIFile.Create(szLAUTrayAppPath + C_LAUTRayINI);
|
|
SectionStringList := TStringList.Create;
|
|
try
|
|
INI.ReadSections(SectionStringList);
|
|
if SectionStringList.Count > 0 then
|
|
begin
|
|
INI.WriteString(SectionStringList[0], 'Location',
|
|
ExtractFilePath(fAppFilename));
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DoSilentUpdate',
|
|
Format('Wrote new entry in section %s. Location=%s',
|
|
[SectionStringList[0], ExtractFilePath(fAppFilename)]));
|
|
end
|
|
else
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DoSilentUpdate',
|
|
'Failed to find a valid section in ' + C_LAUTRayINI);
|
|
finally
|
|
FreeAndNil(SectionStringList);
|
|
FreeAndNil(INI);
|
|
end;
|
|
Result := True;
|
|
end
|
|
else
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DoSilentUpdate',
|
|
'Failed to copy ' + C_LAUTRayINI + ' to ' + szLAUTrayAppPath);
|
|
except
|
|
On E: Exception do
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DoSilentUpdate',
|
|
Format('Could not update %s. Error: %s ', [C_LAUTRayINI, E.Message]));
|
|
end;
|
|
end;
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'DoSilentUpdate', 'Leaving DoSilentUpdate');
|
|
|
|
end;
|
|
|
|
function TLazAutoUpdate.RemoteUpdateToNewVersion: boolean;
|
|
// Used in Systray app
|
|
// Shells to 'lauupdate' console app in ProgramDirectory to remotely update an app
|
|
{$IFDEF WINDOWS}
|
|
function RunAsAdmin(const Handle: THandle; const Path, Params: string): boolean;
|
|
var
|
|
sei: TShellExecuteInfoA;
|
|
begin
|
|
FillChar(sei, SizeOf(sei), 0);
|
|
sei.cbSize := SizeOf(sei);
|
|
sei.Wnd := Handle;
|
|
sei.fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI;
|
|
sei.lpVerb := 'runas';
|
|
sei.lpFile := PAnsiChar(Path);
|
|
sei.lpParameters := PAnsiChar(Params);
|
|
sei.nShow := SW_SHOWNORMAL;
|
|
Result := ShellExecuteExA(@sei);
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
var
|
|
cCount: cardinal;
|
|
szAppDir, szParams: string;
|
|
begin
|
|
Result := False;
|
|
{$IFDEF WINDOWS}
|
|
if fWindowsAdminCheck then
|
|
if not IsWindowsAdmin then
|
|
begin
|
|
ShowAdminCheckMessage;
|
|
Exit;
|
|
end;
|
|
{$ENDIF}
|
|
// fWorkingMode=lauInstall or lauUpdate
|
|
szAppDir := AppendPathDelim(ExtractFilePath(fAppFilename));
|
|
|
|
// read the VMT once
|
|
if Assigned(fOndebugEvent) then
|
|
fFireDebugEvent := True;
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'RemoteUpdateToNewVersion',
|
|
'Entering RemoteUpdateToNewVersion');
|
|
|
|
// Running update using updatehm?
|
|
if ((AppIsRunning(ExtractFileName(fAppFilename)) = False) and
|
|
(ExtractFileName(fAppFilename) <> ExtractFileName(fparentApplication.EXEname))) then
|
|
Result := DoSilentUpdate
|
|
else
|
|
begin
|
|
cCount := 0;
|
|
if not FileExists(ProgramDirectory + C_LAUUPDATENAME) then
|
|
begin
|
|
if fShowDialogs then
|
|
ShowMessageFmt(C_UpdaterMissing, [ProgramDirectory + C_LAUUPDATENAME]);
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'RemoteUpdateToNewVersion',
|
|
Format(C_UpdaterMissing, [ProgramDirectory + C_LAUUPDATENAME]));
|
|
Exit;
|
|
end;
|
|
|
|
if not DirectoryExistsUTF8(szAppDir + fUpdatesFolder) then
|
|
begin
|
|
if fShowDialogs then
|
|
ShowMessageFmt(C_FolderMissing, [szAppDir + fUpdatesFolder]);
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'RemoteUpdateToNewVersion',
|
|
Format(C_FolderMissing, [szAppDir + fUpdatesFolder]));
|
|
Exit;
|
|
end;
|
|
|
|
|
|
{$IFDEF WINDOWS}
|
|
szParams := ExtractFileName(fAppFilename);
|
|
szParams := szParams + ' ' + fUpdatesFolder;
|
|
szParams := szParams + ' ' + C_WhatsNewFilename;
|
|
szParams := szParams + ' ' + fParentApplication.Title;
|
|
if (fCopyTree = True) then
|
|
szParams := szParams + ' copytree';
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'RemoteUpdateToNewVersion',
|
|
Format('Executing %s', [ProgramDirectory + C_LAUUPDATENAME]));
|
|
RunAsAdmin(fParentForm.Handle, ProgramDirectory + C_LAUUPDATENAME, szParams);
|
|
|
|
// Check for C_WhatsNewFilename in the app directory in a LOOP
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'RemoteUpdateToNewVersion',
|
|
Format('Waiting for %s', [szAppDir + C_WhatsNewFilename]));
|
|
while not FileExistsUTF8(szAppDir + C_WhatsNewFilename) do
|
|
begin
|
|
fParentApplication.ProcessMessages;
|
|
Inc(CCount);
|
|
if cCount > 10000000 then
|
|
Break; // Get out of jail in case updatehm.exe fails to copy file
|
|
end;
|
|
{$ELSE}
|
|
|
|
// Update and re-start the app
|
|
FUpdateHMProcess := TAsyncProcess.Create(nil);
|
|
FUpdateHMProcess.Executable := ProgramDirectory + C_LAUUPDATENAME;
|
|
FUpdateHMProcess.CurrentDirectory := ProgramDirectory;
|
|
if not fSilentMode then
|
|
FUpdateHMProcess.ConsoleTitle :=
|
|
Format(C_ConsoleTitle, [fParentApplication.Title]);
|
|
FUpdateHMProcess.Parameters.Clear;
|
|
FUpdateHMProcess.Parameters.Add(fAppFilename); //Param 1 = EXEname
|
|
FUpdateHMProcess.Parameters.Add(fUpdatesFolder); // Param 2 = updates
|
|
FUpdateHMProcess.Parameters.Add(C_WhatsNewFilename); // Param 3 = whatsnew.txt
|
|
FUpdateHMProcess.Parameters.Add(fParentApplication.Title); // Param 4 = Prettyname
|
|
if (fCopyTree = True) then
|
|
FUpdateHMProcess.Parameters.Add('copytree');
|
|
// Param 5 = Copy the whole of /updates to the App Folder
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'RemoteUpdateToNewVersion',
|
|
Format('Executing %s', [ProgramDirectory + C_LAUUPDATENAME]));
|
|
|
|
try
|
|
FUpdateHMProcess.Execute;
|
|
|
|
// Check for C_WhatsNewFilename in the app directory in a LOOP
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'RemoteUpdateToNewVersion',
|
|
Format('Waiting for %s', [szAppDir + C_WhatsNewFilename]));
|
|
while not FileExists(szAppDir + C_WhatsNewFilename) do
|
|
begin
|
|
fParentApplication.ProcessMessages;
|
|
Inc(CCount);
|
|
if cCount > 10000000 then
|
|
Break; // Get out of jail in case updatehm.exe fails to copy file
|
|
end;
|
|
finally
|
|
FUpdateHMProcess.Free;
|
|
end;
|
|
{$ENDIF}
|
|
// remotely shut down the app?
|
|
if fSilentMode then
|
|
begin
|
|
if AppIsRunning(ExtractFileName(fAppFilename)) then
|
|
KillApp(ExtractFileName(fAppFilename));
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'RemoteUpdateToNewVersion',
|
|
Format('Killing %s ready for update', [fAppFilename]));
|
|
end;
|
|
|
|
if not fSilentMode then
|
|
fParentForm.Close;
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'RemoteUpdateToNewVersion',
|
|
'Success');
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF LINUX}
|
|
function TLazAutoUpdate.SetExecutePermission(const AFileName: string;
|
|
var AErrMsg: string): boolean;
|
|
var
|
|
SL: TStringList;
|
|
Process: TProcess;
|
|
begin
|
|
Result := False;
|
|
Process := TProcess.Create(nil);
|
|
try
|
|
Process.Executable := '/bin/chmod';
|
|
Process.Parameters.Add('+X');
|
|
Process.Parameters.Add(AFileName);
|
|
Process.Options := Process.Options + [poWaitOnExit, poUsePipes];
|
|
Process.Execute;
|
|
SL := TStringList.Create;
|
|
try
|
|
SL.LoadFromStream(Process.Stderr);
|
|
AErrMsg := Trim(SL.Text);
|
|
Result := Trim(AErrMsg) = '';
|
|
finally
|
|
SL.Free;
|
|
end;
|
|
finally
|
|
Process.Free;
|
|
end;
|
|
end;
|
|
|
|
{$ENDIF}
|
|
{
|
|
procedure CheckPermissions;
|
|
var
|
|
ErrMsg: String;
|
|
begin
|
|
if SetExecutePermission('/minesadorada/developer/updates/consoleupdater', ErrMsg) then
|
|
MessageDlg('Permission successfully set.', mtInformation, [mbOk], 0)
|
|
else
|
|
MessageDlg('Cannot set permission. Error message: ' + ErrMsg, mtError, [mbOk], 0);
|
|
end;
|
|
}
|
|
function TLazAutoUpdate.UpdateToNewVersion: boolean;
|
|
// Shells to updater console
|
|
// Requires admin user in Win 10
|
|
{$IFDEF WINDOWS}
|
|
function RunAsAdmin(const Handle: THandle; const Path, Params: string): boolean;
|
|
var
|
|
sei: TShellExecuteInfoA;
|
|
begin
|
|
FillChar(sei, SizeOf(sei), 0);
|
|
sei.cbSize := SizeOf(sei);
|
|
sei.Wnd := Handle;
|
|
sei.fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI;
|
|
sei.lpVerb := 'runas';
|
|
sei.lpFile := PAnsiChar(Path);
|
|
sei.lpParameters := PAnsiChar(Params);
|
|
sei.nShow := SW_SHOWNORMAL;
|
|
Result := ShellExecuteExA(@sei);
|
|
end;
|
|
|
|
{$ENDIF}
|
|
var
|
|
cCount: cardinal;
|
|
szAppDir: string;
|
|
szParams: string;
|
|
{$IFDEF LINUX}
|
|
ErrMsg: string;
|
|
{$ENDIF}
|
|
begin
|
|
Result := False;
|
|
{$IFDEF WINDOWS}
|
|
if fWindowsAdminCheck then
|
|
if not IsWindowsAdmin then
|
|
begin
|
|
ShowAdminCheckMessage;
|
|
Exit;
|
|
end;
|
|
{$ENDIF}
|
|
szAppDir := AppendPathDelim(ExtractFilePath(fAppFilename));
|
|
|
|
// read the VMT once
|
|
if Assigned(fOndebugEvent) then
|
|
fFireDebugEvent := True;
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'UpdateToNewVersion',
|
|
'Entering UpdateToNewVersion');
|
|
|
|
// Running update using updatehm?
|
|
if not AppIsRunning(ExtractFileName(fAppFilename)) then
|
|
begin
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'UpdateToNewVersion', 'Doing SilentUpdate');
|
|
Result := DoSilentUpdate;
|
|
end
|
|
else
|
|
begin
|
|
// Start Regular update
|
|
cCount := 0;
|
|
if not FileExists(szAppDir + C_UPDATEHMNAME) then
|
|
begin
|
|
if fShowDialogs then
|
|
ShowMessageFmt(C_UpdaterMissing, [szAppDir + C_UPDATEHMNAME]);
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'UpdateToNewVersion',
|
|
Format(C_UpdaterMissing, [szAppDir + C_UPDATEHMNAME]));
|
|
Exit;
|
|
end;
|
|
{$IFDEF LINUX}
|
|
if not SetExecutePermission(szAppDir + C_UPDATEHMNAME, ErrMsg) then
|
|
begin
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'UpdateToNewVersion',
|
|
Format('Unable to set permissions for %s because of %s',
|
|
[szAppDir + fUpdatesFolder, ErrMsg]));
|
|
if fShowDialogs then
|
|
ShowMessageFmt('Unable to set permissions for %s because of %s',
|
|
[szAppDir + fUpdatesFolder, ErrMsg]);
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
if not DirectoryExistsUTF8(szAppDir + fUpdatesFolder) then
|
|
begin
|
|
if fShowDialogs then
|
|
ShowMessageFmt(C_FolderMissing, [szAppDir + fUpdatesFolder]);
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'UpdateToNewVersion',
|
|
Format(C_FolderMissing, [szAppDir + fUpdatesFolder]));
|
|
Exit;
|
|
end;
|
|
|
|
|
|
// remotely shut down the app?
|
|
if fSilentMode then
|
|
begin
|
|
if AppIsRunning(ExtractFileName(fAppFilename)) then
|
|
KillApp(ExtractFileName(fAppFilename));
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'UpdateToNewVersion',
|
|
Format('Killing %s ready for update', [fAppFilename]));
|
|
end;
|
|
{$IFDEF WINDOWS}
|
|
szParams := ExtractFileName(fAppFilename);
|
|
szParams := szParams + ' ' + fUpdatesFolder;
|
|
szParams := szParams + ' ' + C_WhatsNewFilename;
|
|
szParams := szParams + ' ' + fParentApplication.Title;
|
|
if (fCopyTree = True) then
|
|
szParams := szParams + ' copytree';
|
|
fOndebugEvent(Self, 'UpdateToNewVersion',
|
|
Format('Executing %s', [szAppDir + C_UPDATEHMNAME]));
|
|
if RunAsAdmin(fParentForm.Handle, szAppDir + C_UPDATEHMNAME, szParams) then
|
|
begin
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'UpdateToNewVersion', 'RunAsAdmin succeeded');
|
|
end
|
|
else
|
|
begin
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'UpdateToNewVersion', 'RunAsAdmin failed');
|
|
end;
|
|
// Check for C_WhatsNewFilename in the app directory in a LOOP
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'UpdateToNewVersion',
|
|
Format('Waiting for %s', [szAppDir + C_WhatsNewFilename]));
|
|
while not FileExistsUTF8(szAppDir + C_WhatsNewFilename) do
|
|
begin
|
|
fParentApplication.ProcessMessages;
|
|
Inc(CCount);
|
|
if cCount > 10000000 then
|
|
Break; // Get out of jail in case updatehm.exe fails to copy file
|
|
end;
|
|
{$ELSE}
|
|
// Update and re-start the app
|
|
FUpdateHMProcess := TAsyncProcess.Create(nil);
|
|
try
|
|
// FUpdateHMProcess.Executable := AppendPathDelim(GetAppConfigDir(false)) + C_UPDATEHMNAME;
|
|
FUpdateHMProcess.Executable := szAppDir + C_UPDATEHMNAME;
|
|
// FUpdateHMProcess.CurrentDirectory := AppendPathDelim(GetAppConfigDir(false));
|
|
FUpdateHMProcess.CurrentDirectory := szAppDir;
|
|
if not fSilentMode then
|
|
FUpdateHMProcess.ConsoleTitle :=
|
|
Format(C_ConsoleTitle, [fParentApplication.Title]);
|
|
FUpdateHMProcess.Parameters.Clear;
|
|
FUpdateHMProcess.Parameters.Add(ExtractFileName(fAppFilename)); //Param 1 = EXEname
|
|
FUpdateHMProcess.Parameters.Add(fUpdatesFolder); // Param 2 = updates
|
|
FUpdateHMProcess.Parameters.Add(C_WhatsNewFilename); // Param 3 = whatsnew.txt
|
|
FUpdateHMProcess.Parameters.Add(fParentApplication.Title); // Param 4 = Prettyname
|
|
if (fCopyTree = True) then
|
|
FUpdateHMProcess.Parameters.Add('copytree');
|
|
// Param 5 = Copy the whole of /updates to the App Folder
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'UpdateToNewVersion',
|
|
Format('Executing %s', [szAppDir + C_UPDATEHMNAME]));
|
|
try
|
|
FUpdateHMProcess.Execute;
|
|
except
|
|
raise Exception.CreateFmt(
|
|
'Error %d: Run this application in Administrator mode or turn off UAC',
|
|
[GetLastOSError]);
|
|
end;
|
|
// Check for C_WhatsNewFilename in the app directory in a LOOP
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'UpdateToNewVersion',
|
|
Format('Waiting for %s', [szAppDir + C_WhatsNewFilename]));
|
|
while not FileExists(szAppDir + C_WhatsNewFilename) do
|
|
begin
|
|
fParentApplication.ProcessMessages;
|
|
Inc(CCount);
|
|
if cCount > 100000 then
|
|
begin
|
|
// Fire the OnUpdated event
|
|
if Assigned(fOnUpdated) then
|
|
begin
|
|
fOnUpdated(Self, fGUIOnlineVersion, 'Unsuccessful update');
|
|
Application.ProcessMessages;
|
|
Sleep(100);
|
|
end;
|
|
Break; // Get out of jail in case updatehm.exe fails to copy file
|
|
end;
|
|
end;
|
|
finally
|
|
FUpdateHMProcess.Free;
|
|
end;
|
|
{$ENDIF}
|
|
CreateLocalLauImportFile; // Creates a new import file in GetAppConfigDirUTF8
|
|
|
|
// Fire the OnUpdated event
|
|
if Assigned(fOnUpdated) then
|
|
begin
|
|
fOnUpdated(Self, fGUIOnlineVersion, 'Successful update');
|
|
Application.ProcessMessages;
|
|
Sleep(100);
|
|
end;
|
|
|
|
if fFireDebugEvent then
|
|
fOndebugEvent(Self, 'UpdateToNewVersion',
|
|
'Success');
|
|
if not fSilentMode then
|
|
fParentForm.Close;
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TLazAutoUpdate.ClearUpdateList;
|
|
// Unused
|
|
begin
|
|
Setlength(fUpdateList, 0);
|
|
end;
|
|
|
|
function TLazAutoUpdate.AddToUpdateList(APrettyName, APath, AVersionString: string;
|
|
AVersionNumber: cardinal): integer;
|
|
// Unused
|
|
var
|
|
iLast: integer;
|
|
TheRec: UpdateListRecord;
|
|
begin
|
|
Setlength(fUpdateList, 0);
|
|
iLast := High(fUpdateList);
|
|
if (iLast = -1) then
|
|
iLast := 0; // For when array is empty
|
|
if (iLast = 1) then
|
|
Exit; // TEMP: Only one entry allowed
|
|
|
|
|
|
try
|
|
Inc(iLast);
|
|
Setlength(fUpdateList, iLast);
|
|
with TheRec do
|
|
begin
|
|
PrettyName := APrettyName;
|
|
Path := APath;
|
|
VersionString := AVersionString;
|
|
VersionNumber := AVersionNumber;
|
|
end;
|
|
fUpdateList[iLast - 1] := TheRec; // Remember array is zero-based
|
|
finally
|
|
Result := High(fUpdateList); // 0 = one element
|
|
fUpdateListCount := Result + 1; // 1 = one element
|
|
end;
|
|
if (Result = 0) then
|
|
begin
|
|
fAppFilename := fUpdateList[iLast - 1].Path;
|
|
fDownloadZipName := ChangeFileExt(fAppFilename, '.zip');
|
|
fZipfileName := fDownloadZipName;
|
|
fApplicationVersionString := fUpdateList[iLast - 1].VersionString;
|
|
end;
|
|
|
|
end;
|
|
|
|
function TLazAutoUpdate.GetThreadDownloadReturnCode: integer;
|
|
begin
|
|
Result := 0;
|
|
if ThreadDownload.ThreadFinished then
|
|
Result := fDownloadWrapper.fReturnCode;
|
|
end;
|
|
|
|
procedure TLazAutoUpdate.SetProjectType(AValue: TProjectType);
|
|
// Set properties in a context-sensitive way
|
|
begin
|
|
if (AValue <> fProjectType) then
|
|
fProjectType := AValue;
|
|
|
|
if fProjectType = auOther then
|
|
begin
|
|
fSourceForgeProjectName := C_NotApplicable;
|
|
fGitHubRepositoryName := C_NotApplicable;
|
|
fGitHubProjectName := C_NotApplicable;
|
|
fGitHubBranchOrTag := C_NotApplicable;
|
|
fauOtherSourceFilename := '';
|
|
fauOtherSourceURL := '';
|
|
end;
|
|
if fProjectType = auSourceForge then
|
|
begin
|
|
fUpdatesFolder := C_UpdatesFolder;
|
|
fSourceForgeProjectName := '';
|
|
fauOtherSourceFilename := C_NotApplicable;
|
|
fauOtherSourceURL := C_NotApplicable;
|
|
fGitHubRepositoryName := C_NotApplicable;
|
|
fGitHubProjectName := C_NotApplicable;
|
|
fGitHubBranchOrTag := C_NotApplicable;
|
|
end;
|
|
if fProjectType = auGitHubReleaseZip then
|
|
begin
|
|
fZipFileName := ChangeFileExt(fVersionsININame, '.zip');
|
|
fUpdatesFolder := C_UpdatesFolder;
|
|
fSourceForgeProjectName := C_NotApplicable;
|
|
fauOtherSourceFilename := C_NotApplicable;
|
|
fauOtherSourceURL := C_NotApplicable;
|
|
fGitHubBranchOrTag := C_MASTER;
|
|
fGitHubRepositoryName := '';
|
|
fGitHubProjectName := '';
|
|
fUpdatesFolder := C_NotApplicable;
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TLazAutoUpdate.SetSourceForgeProjectName(Avalue: string);
|
|
// Ensure lowercase
|
|
begin
|
|
fSourceForgeProjectName := LowerCase(AValue);
|
|
end;
|
|
|
|
procedure TLazAutoUpdate.SetAppFilename(Avalue: string);
|
|
// Guess a default value
|
|
begin
|
|
fAppFilename := AValue;
|
|
// Set a default value?
|
|
if (fDownloadZipName = '') then
|
|
fDownloadZipName := ChangeFileExt(ExtractFilename(fAppFilename), '.zip');
|
|
fDownloadWrapper.Filename := fUpdatesFolder + PathDelim + fDownloadZipName;
|
|
end;
|
|
|
|
procedure TLazAutoUpdate.SetApplicationVersionString(Avalue: string);
|
|
begin
|
|
if AValue = '' then
|
|
Exit;
|
|
fApplicationVersionString := AValue;
|
|
fApplicationVersionQuad := StrToVersionQuad(fApplicationVersionString);
|
|
end;
|
|
|
|
// Threaded version
|
|
// ================
|
|
// Var bDownloadIsPresent:Boolean;
|
|
// MyTheadDownload:TDownloadWrapper;
|
|
// Begin
|
|
// MyTheadDownload:=TDownloadWrapper.Create(sourceforgedownloadURL,Localfilepath);
|
|
// {
|
|
// Note the Localfilepath MUST be specified, and can be a different filename and path
|
|
// than the filename specified in the sourceforgedownloadURL
|
|
// }
|
|
// bDownloadIsPresent:=MyTheadDownload.ThreadDownloadHTTP;
|
|
// MyTheadDownload.UnzipAfter:=FALSE; // True *by default* if targetfile is a zip file
|
|
// If NOT bDownloadIsPresent then Exit; {BailOut ->}
|
|
// WHILE NOT MyThreadDownload.ThreadFinished do
|
|
// begin
|
|
// {.. show the user it is downloading in the background}
|
|
// Application.ProcessMessages; // <- Very Important; else the app will freeze!
|
|
// end;
|
|
// {File has now downloaded OK to Localfilepath (and is optionally unzipped)}
|
|
// MyTheadDownload.Free;
|
|
// End;
|
|
|
|
|
|
{ TDownloadThreadClass }
|
|
|
|
constructor TDownloadThreadClass.Create(CreateSuspended: boolean);
|
|
begin
|
|
inherited Create(CreateSuspended);
|
|
fReturnCode := 0; // Failure code
|
|
fDownloadSize := 0;
|
|
FreeOnTerminate := True;
|
|
fLastError := C_OK;
|
|
end;
|
|
|
|
destructor TDownloadThreadClass.Destroy;
|
|
begin
|
|
FreeAndNil(fHTTPClient);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TDownloadThreadClass.DoPercent(Sender: TObject;
|
|
const ContentLength, CurrentPos: int64);
|
|
begin
|
|
fPercent := integer((Trunc((CurrentPos / ContentLength) * 100)));
|
|
end;
|
|
|
|
procedure TDownloadThreadClass.Execute;
|
|
begin
|
|
fHTTPClient := TFPHTTPClient.Create(nil);
|
|
// OnThreadDataEvent:=fHTTPClient.OnDataReceived;
|
|
// fHTTPClient.OnDataReceived:=@DoPercent;
|
|
// Start the download procedure
|
|
fDownloadSize := GetDownloadFileSize(fURL, fIsRepositoryURL);
|
|
if (fDownloadSize > 0) then
|
|
begin
|
|
fDownloadSize := 0;
|
|
DownloadHTTP(fURL, fFileName, fReturnCode, fDownloadSize,
|
|
fIsRepositoryURL, fDebugMode);
|
|
end
|
|
else
|
|
fLastError := 'Zero Size';
|
|
|
|
end;
|
|
|
|
constructor TDownloadWrapper.Create();
|
|
// Called from LazAutoUpdate.Create
|
|
begin
|
|
inherited Create;
|
|
fThreadFinished := False;
|
|
fAppLicationVersionString := '0.0.1';
|
|
fComponentVersion := C_TThreadedDownloadComponentVersion;
|
|
fLastError := C_OK;
|
|
// Create the thread (suspended)
|
|
fdownload := TDownloadThreadClass.Create(True);
|
|
fdownload.FreeOnTerminate := True;
|
|
fdownload.OnTerminate := @DownloadTerminiated;
|
|
end;
|
|
|
|
destructor TDownloadWrapper.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TDownloadWrapper }
|
|
|
|
function TDownloadWrapper.ThreadDownloadHTTP: boolean;
|
|
begin
|
|
if (CompareFileExt(ExtractFilename(fFileName), 'zip', False) = 0) then
|
|
fUnzipAfter := True
|
|
else
|
|
fUnzipAfter := False;
|
|
if Assigned(OnDownloadWrapperFileWriteProgress) then
|
|
fdownload.OnThreadFileWriteProgress := OnDownloadWrapperFileWriteProgress;
|
|
fdownload.fIsRepositoryURL := fIsCodeRepository;
|
|
fdownload.fDebugMode := fDebugMode;
|
|
fdownload.fLastError := fLastError;
|
|
fdownload.fURL := URL;
|
|
fdownload.fFileName := FileName;
|
|
fdownload.fDownloadSize := 0;
|
|
fdownload.start;
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TDownloadWrapper.DownloadTerminiated(Sender: TObject);
|
|
// Unzips all files ready for updatehmxxx to copy them over
|
|
var
|
|
UnZipper: TUnZipper;
|
|
begin
|
|
FreeAndNil(fDownload.fHTTPClient);
|
|
fReturnCode := fdownload.fReturnCode;
|
|
fDownloadSize := fdownload.fDownloadSize;
|
|
fLastError := fdownload.fLastError;
|
|
fThreadFinished := True;
|
|
if fReturnCode = 401 then
|
|
Exit;
|
|
if (FileExists(fFileName) = True) and
|
|
(CompareFileExt(fFileName, '.zip', False) = 0) then
|
|
if fUnzipAfter then
|
|
begin
|
|
UnZipper := TUnZipper.Create;
|
|
try
|
|
UnZipper.FileName := fFileName;
|
|
UnZipper.OutputPath := ExtractFileDir(fFileName);
|
|
UnZipper.Examine;
|
|
UnZipper.UnZipAllFiles;
|
|
if FileExists(fFileName) then
|
|
SysUtils.DeleteFile(fFileName);
|
|
finally
|
|
UnZipper.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ End of class members}
|
|
|
|
function TDownloadThreadClass.GetPercent: integer;
|
|
begin
|
|
Result := fPercent;
|
|
end;
|
|
|
|
procedure TDownloadThreadClass.SetPercent(AValue: integer);
|
|
begin
|
|
fPercent := AValue;
|
|
end;
|
|
|
|
function TDownloadThreadClass.GetDownloadFileSize(URL: string;
|
|
bIsRepositoryURL: boolean): int64;
|
|
var
|
|
VSize: int64 = 0;
|
|
I: integer;
|
|
S: string;
|
|
begin
|
|
try
|
|
if bIsRepositoryURL then
|
|
fHTTPClient.AllowRedirect := True;
|
|
try
|
|
fHTTPClient.HTTPMethod('HEAD', URL, nil, [200]);
|
|
except
|
|
Result := 0;
|
|
end;
|
|
for I := 0 to pred(fHTTPClient.ResponseHeaders.Count) do
|
|
begin
|
|
S := UpperCase(fHTTPClient.ResponseHeaders[I]);
|
|
if Pos('CONTENT-LENGTH:', S) > 0 then
|
|
begin
|
|
VSize := StrToIntDef(Copy(S, Pos(':', S) + 1, Length(S)), 0);
|
|
Result := VSize;
|
|
Break;
|
|
end;
|
|
end;
|
|
except
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
|
|
function TDownloadThreadClass.DownloadHTTP(URL, TargetFile: string;
|
|
var ReturnCode, DownloadSize: integer; bIsRepositoryURL, Debugmode: boolean): boolean;
|
|
// Download file; retry if necessary.
|
|
// Deals with https download links
|
|
var
|
|
// HTTPClient: TFPHTTPClient;
|
|
vStream: TStreamAdapter;
|
|
vSize: int64;
|
|
begin
|
|
Result := False;
|
|
vSize := GetDownloadFileSize(URL, bIsRepositoryURL);
|
|
if (vSize = 0) then
|
|
Exit;
|
|
if bIsRepositoryURL then
|
|
begin
|
|
fHTTPClient.AllowRedirect := True;
|
|
end;
|
|
// ReturnCode may not be useful, but it's provided here
|
|
try
|
|
try
|
|
// Try to get the file
|
|
// HTTPClient.Get(URL, TargetFile);
|
|
vStream := TStreamAdapter.Create(TFileStream.Create(TargetFile, fmCreate), VSize);
|
|
if Assigned(OnThreadFileWriteProgress) then
|
|
vStream.OnFileWriteProgress := OnThreadFileWriteProgress;
|
|
fHTTPClient.OnDataReceived := @DoPercent;
|
|
|
|
fHTTPClient.HTTPMethod('GET', Url, vStream, [200]);
|
|
ReturnCode := fHTTPClient.ResponseStatusCode;
|
|
DownloadSize := Filesize(TargetFile);
|
|
Result := True;
|
|
except
|
|
// We don't care for the reason for this error; the download failed.
|
|
if FileExists(TargetFile) then
|
|
SysUtils.DeleteFile(TargetFile);
|
|
ReturnCode := 401;
|
|
DownloadSize := 0;
|
|
Result := False;
|
|
end;
|
|
finally
|
|
vStream.Free;
|
|
end;
|
|
|
|
end;
|
|
|
|
constructor TStreamAdapter.Create(AStream: TStream; ASize: int64);
|
|
begin
|
|
inherited Create;
|
|
FStream := AStream;
|
|
fStream.Size := ASize;
|
|
fStream.Position := 0;
|
|
end;
|
|
|
|
destructor TStreamAdapter.Destroy;
|
|
begin
|
|
FStream.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TStreamAdapter.Read(var Buffer; Count: longint): longint;
|
|
begin
|
|
Result := FStream.Read(Buffer, Count);
|
|
DoProgress(False);
|
|
end;
|
|
|
|
function TStreamAdapter.Write(const Buffer; Count: longint): longint;
|
|
begin
|
|
Result := FStream.Write(Buffer, Count);
|
|
DoProgress(True);
|
|
end;
|
|
|
|
function TStreamAdapter.Seek(Offset: longint; Origin: word): longint;
|
|
begin
|
|
Result := FStream.Seek(Offset, Origin);
|
|
end;
|
|
|
|
procedure TStreamAdapter.DoProgress(Writing: boolean);
|
|
begin
|
|
fPercent := Trunc((FStream.Position) / (FStream.Size) * 100);
|
|
//WriteLn(FStream.Size);
|
|
if Assigned(OnFileWriteProgress) then
|
|
begin
|
|
OnFileWriteProgress(self, FPercent);
|
|
end;
|
|
end;
|
|
|
|
|
|
end.
|