diff --git a/components/lazautoupdate/latest_stable/lazupdate.lpk b/components/lazautoupdate/latest_stable/lazupdate.lpk index aa67099d1..a81aac19d 100644 --- a/components/lazautoupdate/latest_stable/lazupdate.lpk +++ b/components/lazautoupdate/latest_stable/lazupdate.lpk @@ -66,8 +66,8 @@ More information in the Wiki Home Page http://wiki.freepascal.org/LazAutoUpdater along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. "/> - - + + @@ -94,6 +94,10 @@ More information in the Wiki Home Page http://wiki.freepascal.org/LazAutoUpdater + + + + diff --git a/components/lazautoupdate/latest_stable/lazupdate.pas b/components/lazautoupdate/latest_stable/lazupdate.pas index 7cb8b30a2..50c7859f3 100644 --- a/components/lazautoupdate/latest_stable/lazupdate.pas +++ b/components/lazautoupdate/latest_stable/lazupdate.pas @@ -9,7 +9,7 @@ interface uses ulazautoupdate, aboutlazautoupdateunit, VersionSupport, uappisrunning, - lazautoupdate_httpclient, open_ssl, LazarusPackageIntf; + lazautoupdate_httpclient, open_ssl, ushortcut, LazarusPackageIntf; implementation diff --git a/components/lazautoupdate/latest_stable/testapp/testapp.lpi b/components/lazautoupdate/latest_stable/testapp/testapp.lpi index 84d0225c7..e68e169eb 100644 --- a/components/lazautoupdate/latest_stable/testapp/testapp.lpi +++ b/components/lazautoupdate/latest_stable/testapp/testapp.lpi @@ -66,6 +66,7 @@ + diff --git a/components/lazautoupdate/latest_stable/testapp/testapp.lpr b/components/lazautoupdate/latest_stable/testapp/testapp.lpr index 8553718f1..7a9cf8912 100644 --- a/components/lazautoupdate/latest_stable/testapp/testapp.lpr +++ b/components/lazautoupdate/latest_stable/testapp/testapp.lpr @@ -35,8 +35,7 @@ uses cthreads, {$ENDIF}{$ENDIF} Interfaces, // this includes the LCL widgetset - Forms, umainform, open_ssl - { you can add units after this }; + Forms, umainform, open_ssl; {$R *.res} diff --git a/components/lazautoupdate/latest_stable/testapp/testapp.lps b/components/lazautoupdate/latest_stable/testapp/testapp.lps index 9060d416d..f2eaead18 100644 --- a/components/lazautoupdate/latest_stable/testapp/testapp.lps +++ b/components/lazautoupdate/latest_stable/testapp/testapp.lps @@ -4,13 +4,13 @@ - + - + - + @@ -20,8 +20,8 @@ - - + + @@ -32,7 +32,7 @@ - + @@ -43,15 +43,15 @@ - - - + + + - - - + + + @@ -59,7 +59,7 @@ - + @@ -146,7 +146,7 @@ - + @@ -184,130 +184,179 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + - - + + - - + + - - + + - - + + - - + + - + - + - + - - + + - + - + - + - - + + - - + + - - + + - - + + - + - + - + - + - + - + - + - + - + - + - + - + - + diff --git a/components/lazautoupdate/latest_stable/testapp/umainform.lfm b/components/lazautoupdate/latest_stable/testapp/umainform.lfm index 12520e7b7..da91e9158 100644 --- a/components/lazautoupdate/latest_stable/testapp/umainform.lfm +++ b/components/lazautoupdate/latest_stable/testapp/umainform.lfm @@ -125,6 +125,8 @@ object mainform: Tmainform GitHubProjectname = 'lazarusccr' GitHubRepositoryName = 'TestApp' GitHubBranchOrTag = 'updates' + ShortCut.ShortcutName = 'AnotherName' + ShortCut.Category = scUtility Left = 200 Top = 24 end diff --git a/components/lazautoupdate/latest_stable/ulazautoupdate.pas b/components/lazautoupdate/latest_stable/ulazautoupdate.pas index d252a682c..2f06e11f2 100644 --- a/components/lazautoupdate/latest_stable/ulazautoupdate.pas +++ b/components/lazautoupdate/latest_stable/ulazautoupdate.pas @@ -58,11 +58,11 @@ interface uses - Forms, Classes, SysUtils, lazautoupdate_httpclient, strutils, + 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, winpeimagereader {need this for reading exe info} + 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 @@ -139,10 +139,10 @@ const V0.3.1: Added SetExecutePermission (LINUX only) V0.3.2: Bugfix for DoSilentUpdate V0.3.3: Added event OnUpdate - V0.3.4: ?? + V0.3.4: Added unit ushortcut (CreateDesktopShortCut) for installers } - C_TLazAutoUpdateComponentVersion = '0.3.3'; - C_TThreadedDownloadComponentVersion = '0.0.3'; + C_TLazAutoUpdateComponentVersion = '0.3.4.0'; + C_TThreadedDownloadComponentVersion = '0.0.3.0'; { V0.0.1: Initial alpha V0.0.2: Added fDebugmode to all classes and functions @@ -228,6 +228,7 @@ resourcestring 'sClick OK to continue'; rsApplicationU = 'Application update'; + type // Dummy thread to initialise the threading system tc = class(tthread) @@ -247,7 +248,7 @@ type end; TThreadedDownload = class; // Forward declaration - + TShortCutClass = class; // Forward declaration {TLAZAUTOUPDATE} // Event declarations TOnNewVersionAvailable = procedure(Sender: TObject; Newer: boolean; @@ -256,7 +257,7 @@ type object; TOnDebugEvent = procedure(Sender: TObject; lauMethodName, lauMessage: string) of object; - TOnUpdated = Procedure(Sender:TObject;NewVersion,LauMessage:String) of Object; + TOnUpdated = procedure(Sender: TObject; NewVersion, LauMessage: string) of object; TLazAutoUpdate = class(TAboutLazAutoUpdate) private @@ -283,6 +284,7 @@ type fShowDialogs: boolean; fDownloadInprogress: boolean; fWindowsAdminCheck: boolean; + fShortCutClass:TShortCutClass; {$IFDEF UNIX} FUpdateHMProcess: TAsyncProcess; {$ENDIF} @@ -294,7 +296,7 @@ type FOnNewVersionAvailable: TOnNewVersionAvailable; FOnDownloaded: TOnDownloaded; fOnDebugEvent: TOnDebugEvent; - fOnUpdated:TOnUpdated; + fOnUpdated: TOnUpdated; fLastError: string; fVersionCountLimit, fDownloadCountLimit: cardinal; fZipfileName: string; @@ -319,8 +321,8 @@ type function GetThreadDownloadReturnCode: integer; function IsOnlineVersionNewer(const sznewINIPath: string): boolean; function DoSilentUpdate: boolean; - function GetUpdateSilentExe:String; - function GetUpdateExe:String; + function GetUpdateSilentExe: string; + function GetUpdateExe: string; protected public @@ -398,7 +400,7 @@ type 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 OnUpdated: TOnUpdated read fOnUpdated write fOnUpdated; // Embedded class property ThreadDownload: TThreadedDownload @@ -447,6 +449,37 @@ type write fGitHubRepositoryName; // Default=master but any branchname or tagname is OK property GitHubBranchOrTag: string read fGitHubBranchOrTag write fGitHubBranchOrTag; + + property ShortCut:TShortCutClass read fShortCutClass write fShortCutClass; + end; + +Type + TShortCutCategory = (scAudioVideo,scAudio,scDevelopment, + scEducation,scGame,scGraphics,scNetwork,scOffice,scScience,scSettings, + scSystem,scUtility); + // TShortCutCategoryFlags = Set of TShortCutCategory; + +Type + TShortCutClass = Class(TPersistent) + private + // ShortCut stuff for CreateDesktopShortCut in ushortcut.pas + fShortCutTarget:String; + fShortCutTargetArguments:String; + fShortCutShortcutName:String; + fShortCutIconFileName:String; + fShortCutCategoryString:String; + + fShortCutCategory:TShortCutCategory; // For easier property access + procedure SetShortCutCategoryString(ACategory:TShortCutCategory); + Public + constructor Create; // Constructor must be public + destructor Destroy; override; // Destructor must be public + 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; {TThreadedDownload } @@ -512,10 +545,18 @@ type procedure ShowProgress; } end; +Type + // 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 version +// Non-threaded function function DownloadHTTP(URL, TargetFile: string; var ReturnCode, DownloadSize: integer; bIsSourceForge, fDebugMode: boolean): boolean; @@ -527,8 +568,39 @@ 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 @@ -544,6 +616,32 @@ begin while MilliSecondOfTheDay(Now) < (ThisSecond + MillisecondDelay) do ; end; +procedure TShortCutClass.SetShortCutCategoryString(ACategory:TShortCutCategory); +{ +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); @@ -650,6 +748,15 @@ 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 @@ -667,6 +774,10 @@ begin // Freed in Destroy fThreadDownload := TThreadedDownload.Create(); + fShortCutClass:=TShortCutClass.Create(); + fShortCutClass.ShortcutName:='MyShortcutName'; + fShortCutClass.TargetArguments:=''; + fShortCutClass.Category:=scDevelopment; // Leave URL and Filename to be set via properties fComponentVersion := C_TLazAutoUpdateComponentVersion; // Unused @@ -773,24 +884,26 @@ end; destructor TLazAutoUpdate.Destroy; begin FreeAndNil(fThreadDownload); + FreeAndNil(fShortCutClass); inherited Destroy; end; -function TLazAutoUpdate.GetUpdateSilentExe:String; + +function TLazAutoUpdate.GetUpdateSilentExe: string; begin fUpdateSilentExe := C_LAUUPDATENAME; - If csDesigning in ComponentState then - Result:='lauupdate' + if csDesigning in ComponentState then + Result := 'lauupdate' else - Result:=fUpdateSilentExe; + Result := fUpdateSilentExe; end; -function TLazAutoUpdate.GetUpdateExe:String; +function TLazAutoUpdate.GetUpdateExe: string; begin fUpdateExe := C_UPDATEHMNAME; - If csDesigning in ComponentState then - Result:='updatehm' + if csDesigning in ComponentState then + Result := 'updatehm' else - Result:=fUpdateExe; + Result := fUpdateExe; end; function TLazAutoUpdate.AppIsActive(const ExeName: string): boolean; @@ -2140,12 +2253,12 @@ begin Inc(CCount); if cCount > 100000 then begin - // Fire the OnUpdated event - If Assigned(fOnUpdated) then + // Fire the OnUpdated event + if Assigned(fOnUpdated) then begin - fOnUpdated(Self,fGUIOnlineVersion,'Unsuccessful update'); - Application.Processmessages; - Sleep(100); + fOnUpdated(Self, fGUIOnlineVersion, 'Unsuccessful update'); + Application.ProcessMessages; + Sleep(100); end; Break; // Get out of jail in case updatehm.exe fails to copy file end; @@ -2156,12 +2269,12 @@ begin {$ENDIF} CreateLocalLauImportFile; // Creates a new import file in GetAppConfigDirUTF8 - // Fire the OnUpdated event - If Assigned(fOnUpdated) then + // Fire the OnUpdated event + if Assigned(fOnUpdated) then begin - fOnUpdated(Self,fGUIOnlineVersion,'Successful update'); - Application.Processmessages; - Sleep(100); + fOnUpdated(Self, fGUIOnlineVersion, 'Successful update'); + Application.ProcessMessages; + Sleep(100); end; if fFireDebugEvent then diff --git a/components/lazautoupdate/latest_stable/ushortcut.pas b/components/lazautoupdate/latest_stable/ushortcut.pas new file mode 100644 index 000000000..a3e6b1d64 --- /dev/null +++ b/components/lazautoupdate/latest_stable/ushortcut.pas @@ -0,0 +1,225 @@ +unit ushortcut; +{ +License +======= +LazAutoUpdate (c)2015 Gordon Bamber (minesadorada@charcodelvalle.com) + +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. + + +Linux Shortcut Info +=================== + +1. FreeDesktop Valid Categories +=============================== +AudioVideo Application for presenting, creating, or processing multimedia (audio/video) +Audio An audio application Desktop entry must include AudioVideo as well +Audio A video application Desktop entry must include AudioVideo as well +Development An application for development +Education Educational software +Game A game +Graphics Application for viewing, creating, or processing graphics +Network Network application such as a web browser +Office An office type application +Science Scientific software +Settings Settings applications Entries may appear in a separate menu or as part of a "Control Center" +System System application, "System Tools" such as say a log viewer or network monitor +Utility Small utility application, "Accessories" + +2. Example Desktop File +======================= +[Desktop Entry] +Version=1.0 +Type=Application +Name=Foo Viewer +Comment=The best viewer for Foo objects available! +TryExec=fooview +Exec=fooview %F +Icon=fooview +MimeType=image/x-foo; +Actions=Gallery;Create; + +[Desktop Action Gallery] +Exec=fooview --gallery +Name=Browse Gallery + +[Desktop Action Create] +Exec=fooview --create-new +Name=Create a new Foo! +Icon=fooview-new +} +{$mode objfpc}{$H+} + +interface +uses + Classes, SysUtils, LazUTF8, FileUtil, LazFileUtils + {$IFDEF LINUX}, process{$ENDIF} + {$IFDEF WINDOWS}, Windows, shlobj {for special folders}, ActiveX, + ComObj, ShellAPI{$ENDIF} ; + +function CreateDesktopShortCut(Target, TargetArguments, ShortcutName, + IconFileName, Category: string): boolean; + +implementation + +{$IFDEF UNIX} +//Adapted from sysutils; Unix/Linux only +function XdgConfigHome: string; +{ Follows base-dir spec, + see [http://freedesktop.org/Standards/basedir-spec]. + Always ends with PathDelim. } +begin + Result := GetEnvironmentVariable('XDG_CONFIG_HOME'); + if (Result = '') then + Result := IncludeTrailingPathDelimiter(ExpandFileNameUTF8('~')) + + '.config' + DirectorySeparator + else + Result := IncludeTrailingPathDelimiter(Result); +end; + +{$ENDIF UNIX} +{$IFDEF MSWINDOWS} +function CreateDesktopShortCut(Target, TargetArguments, ShortcutName, + IconFileName, Category: string): boolean; +var + IObject: IUnknown; + ISLink: IShellLink; + IPFile: IPersistFile; + PIDL: PItemIDList; + InFolder: array[0..MAX_PATH] of char; + LinkName: WideString; +begin + Result := True; + // Simple failure check + if not FileExistsUTF8(Target) then + Result := False; + if Result = False then + Exit; + + try + { Creates an instance of IShellLink } + IObject := CreateComObject(CLSID_ShellLink); + ISLink := IObject as IShellLink; + IPFile := IObject as IPersistFile; + + ISLink.SetPath(PChar(Target)); + ISLink.SetArguments(PChar(TargetArguments)); + ISLink.SetWorkingDirectory(PChar(ExtractFilePath(Target))); + // ISLink.SetIconLocation(Pchar(ExtractFilePath(Target) + IconFileName)); + { Get the desktop location } + SHGetSpecialFolderLocation(0, CSIDL_DESKTOPDIRECTORY, PIDL); + SHGetPathFromIDList(PIDL, InFolder); + LinkName := IncludeTrailingPathDelimiter(InFolder) + ShortcutName + '.lnk'; + + { Get rid of any existing shortcut first } + SysUtils.DeleteFile(LinkName); + + { Create the link } + IPFile.Save(PWChar(LinkName), False); + except + Result := False; + end; +end; + +{$ENDIF MSWINDOWS} +{$IFDEF UNIX} +function CreateDesktopShortCut(Target, TargetArguments, ShortcutName, + IconFileName, Category: string): boolean; +var + XdgDesktopContent: TStringList; + XdgDesktopFile: string; + Aprocess: TProcess; +begin + // Suceed by default: + Result := True; + // Simple failure checks + if not FileExistsUTF8(Target) then + Result := False; + if not FileExistsUTF8(ExtractFilePath(Target) + IconFileName) then + Result := False; + if ShortCutName = '' then + Result := False; + if Result = False then + Exit; + if Category = '' then Category := 'Utility'; + + XdgDesktopFile := IncludeTrailingPathDelimiter(GetTempDir(False)) + + 'fpcup-' + shortcutname + '.desktop'; + XdgDesktopContent := TStringList.Create; + try + XdgDesktopContent.Add('[Desktop Entry]'); + XdgDesktopContent.Add('Encoding=UTF-8'); + XdgDesktopContent.Add('Type=Application'); + XdgDesktopContent.Add('Icon=' + ExtractFilePath(Target) + IconFileName); + XdgDesktopContent.Add('Exec=' + Target + ' ' + TargetArguments); + XdgDesktopContent.Add('Name=' + ShortcutName); + XdgDesktopContent.Add('Category=' + Category + ';'); + // We're going to try and call xdg-desktop-icon + // this may fail if shortcut exists already + AProcess := TProcess.Create(nil); + try + try + XdgDesktopContent.SaveToFile(XdgDesktopFile); + AProcess.Parameters.Add(XdgDesktopFile); + Aprocess.Executable := 'xdg-desktop-icon install'; + Aprocess.WaitOnExit(2000); + Aprocess.Execute; + //OperationSucceeded:=(ExecuteCommand('xdg-desktop-icon install ' + XdgDesktopFile,false)=0); + except + Result := False; + end; + finally + AProcess.Free; + end; + if Result = False then + // Temp file is no longer needed.... + try + DeleteFile(XdgDesktopFile); + finally + // Swallow, let filesystem maintenance clear it up + end; + finally + XdgDesktopContent.Free; + end; +end; + +{$ENDIF UNIX} +{$IFDEF MSWINDOWS} +procedure DeleteDesktopShortcut(ShortcutName: string); +var + PIDL: PItemIDList; + InFolder: array[0..MAX_PATH] of char; + LinkName: WideString; +begin + { Get the desktop location } + SHGetSpecialFolderLocation(0, CSIDL_DESKTOPDIRECTORY, PIDL); + SHGetPathFromIDList(PIDL, InFolder); + LinkName := IncludeTrailingPathDelimiter(InFolder) + ShortcutName + '.lnk'; + SysUtils.DeleteFile(LinkName); +end; + +{$ENDIF MSWINDOWS} +end.