diff --git a/components/lazautoupdate/latest_stable/lazupdate.lpk b/components/lazautoupdate/latest_stable/lazupdate.lpk index 02ea445f8..654d04774 100644 --- a/components/lazautoupdate/latest_stable/lazupdate.lpk +++ b/components/lazautoupdate/latest_stable/lazupdate.lpk @@ -66,7 +66,7 @@ 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. "/> - + diff --git a/components/lazautoupdate/latest_stable/testinstaller/lauinstaller.lpi b/components/lazautoupdate/latest_stable/testinstaller/lauinstaller.lpi index 785da7b64..b7ad4b138 100644 --- a/components/lazautoupdate/latest_stable/testinstaller/lauinstaller.lpi +++ b/components/lazautoupdate/latest_stable/testinstaller/lauinstaller.lpi @@ -20,9 +20,8 @@ - - - + + diff --git a/components/lazautoupdate/latest_stable/testinstaller/lauinstaller.lpr b/components/lazautoupdate/latest_stable/testinstaller/lauinstaller.lpr index 4cf204e48..b2e071e24 100644 --- a/components/lazautoupdate/latest_stable/testinstaller/lauinstaller.lpr +++ b/components/lazautoupdate/latest_stable/testinstaller/lauinstaller.lpr @@ -39,8 +39,7 @@ uses cthreads, {$ENDIF}{$ENDIF} Interfaces, // this includes the LCL widgetset - Forms, umainform - { you can add units after this }; + Forms, umainform; {$R *.res} diff --git a/components/lazautoupdate/latest_stable/testinstaller/lauinstaller.lps b/components/lazautoupdate/latest_stable/testinstaller/lauinstaller.lps index 43057397f..8f11d813c 100644 --- a/components/lazautoupdate/latest_stable/testinstaller/lauinstaller.lps +++ b/components/lazautoupdate/latest_stable/testinstaller/lauinstaller.lps @@ -4,14 +4,13 @@ - + - - + - + @@ -20,9 +19,9 @@ - - - + + + @@ -35,17 +34,19 @@ - - - - + + + + + - - - + + + + @@ -61,127 +62,203 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - + - + - + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - + - + - + - - + + - + - - + + diff --git a/components/lazautoupdate/latest_stable/testinstaller/lauinstaller.res b/components/lazautoupdate/latest_stable/testinstaller/lauinstaller.res index 44b761133..8220c6c97 100644 Binary files a/components/lazautoupdate/latest_stable/testinstaller/lauinstaller.res and b/components/lazautoupdate/latest_stable/testinstaller/lauinstaller.res differ diff --git a/components/lazautoupdate/latest_stable/testinstaller/locale/lauinstaller.po b/components/lazautoupdate/latest_stable/testinstaller/locale/lauinstaller.po index 736538622..6c18167af 100644 --- a/components/lazautoupdate/latest_stable/testinstaller/locale/lauinstaller.po +++ b/components/lazautoupdate/latest_stable/testinstaller/locale/lauinstaller.po @@ -5,10 +5,18 @@ msgstr "Content-Type: text/plain; charset=UTF-8" msgid "mainform" msgstr "" +#: tmainform.cmd_deleteshortcuticon.caption +msgid "Delete Shortcut" +msgstr "" + #: tmainform.cmd_install.caption msgid "Install" msgstr "" +#: tmainform.cmd_makeshortcuticon.caption +msgid "Make Shortcut" +msgstr "" + #: tmainform.cmd_run.caption msgid "Run" msgstr "" @@ -29,3 +37,11 @@ msgstr "" msgid "E&xit" msgstr "" +#: tmainform.mnu_help.caption +msgid "&Help" +msgstr "" + +#: tmainform.mnu_helpcheckforupdates.caption +msgid "Check for updates..." +msgstr "" + diff --git a/components/lazautoupdate/latest_stable/testinstaller/umainform.lfm b/components/lazautoupdate/latest_stable/testinstaller/umainform.lfm index 028a90f80..9620be4b0 100644 --- a/components/lazautoupdate/latest_stable/testinstaller/umainform.lfm +++ b/components/lazautoupdate/latest_stable/testinstaller/umainform.lfm @@ -1,24 +1,26 @@ object mainform: Tmainform - Left = 737 + Left = 728 Height = 241 - Top = 222 - Width = 320 + Top = 209 + Width = 408 BorderIcons = [biSystemMenu, biMinimize] BorderStyle = bsSingle Caption = 'mainform' ClientHeight = 221 - ClientWidth = 320 + ClientWidth = 408 Menu = MainMenu1 + OnActivate = FormActivate OnClose = FormClose OnCloseQuery = FormCloseQuery OnCreate = FormCreate + OnShow = FormShow Position = poWorkAreaCenter LCLVersion = '1.7' Scaled = True object cmd_close: TBitBtn - Left = 125 + Left = 167 Height = 30 - Top = 179 + Top = 176 Width = 75 Anchors = [akRight, akBottom] DefaultCaption = True @@ -31,7 +33,7 @@ object mainform: Tmainform Left = 0 Height = 113 Top = 0 - Width = 320 + Width = 408 Align = alTop AutoFill = True Caption = 'Application' @@ -43,7 +45,7 @@ object mainform: Tmainform ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.ControlsPerLine = 1 ClientHeight = 93 - ClientWidth = 316 + ClientWidth = 404 ItemIndex = 2 Items.Strings = ( 'LazAutoUpdate Update Pack' @@ -58,11 +60,11 @@ object mainform: Tmainform Left = 0 Height = 57 Top = 113 - Width = 320 + Width = 408 Align = alTop Caption = 'Action' ClientHeight = 37 - ClientWidth = 316 + ClientWidth = 404 TabOrder = 2 object cmd_Install: TButton Left = 8 @@ -82,6 +84,26 @@ object mainform: Tmainform OnClick = cmd_RunClick TabOrder = 1 end + object cmd_MakeShortcutIcon: TButton + Left = 176 + Height = 25 + Top = 0 + Width = 103 + AutoSize = True + Caption = 'Make Shortcut' + OnClick = cmd_MakeShortcutIconClick + TabOrder = 2 + end + object cmd_DeleteShortcutIcon: TButton + Left = 288 + Height = 25 + Top = 0 + Width = 107 + AutoSize = True + Caption = 'Delete Shortcut' + OnClick = cmd_DeleteShortcutIconClick + TabOrder = 3 + end end object LazAutoUpdate1: TLazAutoUpdate About.Description.Strings = ( @@ -127,5 +149,12 @@ object mainform: Tmainform OnClick = mnu_fileExitClick end end + object mnu_help: TMenuItem + Caption = '&Help' + object mnu_helpCheckForUpdates: TMenuItem + Caption = 'Check for updates...' + OnClick = mnu_helpCheckForUpdatesClick + end + end end end diff --git a/components/lazautoupdate/latest_stable/testinstaller/umainform.lrj b/components/lazautoupdate/latest_stable/testinstaller/umainform.lrj index d5a2838a1..5623f247e 100644 --- a/components/lazautoupdate/latest_stable/testinstaller/umainform.lrj +++ b/components/lazautoupdate/latest_stable/testinstaller/umainform.lrj @@ -4,6 +4,10 @@ {"hash":75149406,"name":"tmainform.grp_action.caption","sourcebytes":[65,99,116,105,111,110],"value":"Action"}, {"hash":5941372,"name":"tmainform.cmd_install.caption","sourcebytes":[73,110,115,116,97,108,108],"value":"Install"}, {"hash":22974,"name":"tmainform.cmd_run.caption","sourcebytes":[82,117,110],"value":"Run"}, +{"hash":250142468,"name":"tmainform.cmd_makeshortcuticon.caption","sourcebytes":[77,97,107,101,32,83,104,111,114,116,99,117,116],"value":"Make Shortcut"}, +{"hash":228824468,"name":"tmainform.cmd_deleteshortcuticon.caption","sourcebytes":[68,101,108,101,116,101,32,83,104,111,114,116,99,117,116],"value":"Delete Shortcut"}, {"hash":2805797,"name":"tmainform.mnu_file.caption","sourcebytes":[38,70,105,108,101],"value":"&File"}, -{"hash":4710148,"name":"tmainform.mnu_fileexit.caption","sourcebytes":[69,38,120,105,116],"value":"E&xit"} +{"hash":4710148,"name":"tmainform.mnu_fileexit.caption","sourcebytes":[69,38,120,105,116],"value":"E&xit"}, +{"hash":2812976,"name":"tmainform.mnu_help.caption","sourcebytes":[38,72,101,108,112],"value":"&Help"}, +{"hash":5395918,"name":"tmainform.mnu_helpcheckforupdates.caption","sourcebytes":[67,104,101,99,107,32,102,111,114,32,117,112,100,97,116,101,115,46,46,46],"value":"Check for updates..."} ]} diff --git a/components/lazautoupdate/latest_stable/testinstaller/umainform.pas b/components/lazautoupdate/latest_stable/testinstaller/umainform.pas index b60b9c988..ae50db9d6 100644 --- a/components/lazautoupdate/latest_stable/testinstaller/umainform.pas +++ b/components/lazautoupdate/latest_stable/testinstaller/umainform.pas @@ -1,4 +1,5 @@ unit umainform; + { License (MIT) ============= @@ -40,24 +41,33 @@ type { Tmainform } Tmainform = class(TForm) + cmd_DeleteShortcutIcon: TButton; + cmd_MakeShortcutIcon: TButton; cmd_Run: TButton; cmd_Install: TButton; cmd_close: TBitBtn; grp_Action: TGroupBox; LazAutoUpdate1: TLazAutoUpdate; MainMenu1: TMainMenu; + mnu_helpCheckForUpdates: TMenuItem; + mnu_help: TMenuItem; mnu_fileExit: TMenuItem; mnu_file: TMenuItem; grp_Application: TRadioGroup; + procedure cmd_DeleteShortcutIconClick(Sender: TObject); procedure cmd_InstallClick(Sender: TObject); + procedure cmd_MakeShortcutIconClick(Sender: TObject); procedure cmd_RunClick(Sender: TObject); + procedure FormActivate(Sender: TObject); procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormCloseQuery(Sender: TObject; var CanClose: boolean); procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); procedure grp_ApplicationSelectionChanged(Sender: TObject); procedure LazAutoUpdate1DebugEvent(Sender: TObject; lauMethodName, lauMessage: string); procedure mnu_fileExitClick(Sender: TObject); + procedure mnu_helpCheckForUpdatesClick(Sender: TObject); private Logger: TEventLog; procedure ConfigureLazAutoUpdate(const AItemIndex: integer); @@ -72,8 +82,8 @@ var implementation {$R *.lfm} -Var - sDirectoryToInstallTo:String; +var + sDirectoryToInstallTo: string; { Tmainform } @@ -81,9 +91,9 @@ procedure Tmainform.FormCreate(Sender: TObject); begin Caption := Application.Title; Icon := Application.Icon; - sDirectoryToInstallTo:=ProgramDirectory + 'installed'; - LazAutoUpdate1.DebugMode:=TRUE; - LazAutoUpdate1.ShowUpdateInCaption:=True; + sDirectoryToInstallTo := ProgramDirectory + 'installed'; + LazAutoUpdate1.DebugMode := True; + LazAutoUpdate1.ShowUpdateInCaption := True; ConfigureLazAutoUpdate(2); // Default is TestApp Logger := TEventLog.Create(nil); Logger.LogType := ltFile; @@ -91,6 +101,11 @@ begin Logger.Active := True; // Logging uses OnDebugEvent of LazAutoUpdate end; +procedure Tmainform.FormShow(Sender: TObject); +begin + +end; + procedure Tmainform.cmd_InstallClick(Sender: TObject); begin LazAutoUpdate1.WorkingMode := lauInstall; @@ -111,11 +126,40 @@ begin LazAutoUpdate1.WorkingMode := lauUpdate; end; +procedure Tmainform.cmd_DeleteShortcutIconClick(Sender: TObject); +begin + if not FileExistsUTF8(LazAutoUpdate1.AppFileWithPath) then + begin + ShowMessageFmt('%s does not exist! Install it first.', + [LazAutoUpdate1.AppFileWithPath]); + Exit; + end; + if LazAutoUpdate1.DeleteShortCut then + ShowMessage('Desktop shortcut and menu item are toast'); +end; + +procedure Tmainform.cmd_MakeShortcutIconClick(Sender: TObject); +begin + if not FileExistsUTF8(LazAutoUpdate1.AppFileWithPath) then + begin + ShowMessageFmt('%s does not exist! Install it first.', + [LazAutoUpdate1.AppFileWithPath]); + Exit; + end; + if LazAutoUpdate1.MakeShortCut then + ShowMessage('Desktop shortcut and menu item created'); +end; + procedure Tmainform.cmd_RunClick(Sender: TObject); begin RunInstalledApp; end; +procedure Tmainform.FormActivate(Sender: TObject); +begin + LazAutoUpdate1.ShowWhatsNewIfAvailable; +end; + procedure Tmainform.RunInstalledApp; var AProcess: TAsyncProcess; @@ -146,11 +190,11 @@ end; procedure Tmainform.FormCloseQuery(Sender: TObject; var CanClose: boolean); begin - If LazAutoUpdate1.DownloadInProgress Then - Begin - CanClose := False; - ShowMessage('Please wait. Download is still in progress.'); - End; + if LazAutoUpdate1.DownloadInProgress then + begin + CanClose := False; + ShowMessage('Please wait. Download is still in progress.'); + end; end; procedure Tmainform.grp_ApplicationSelectionChanged(Sender: TObject); @@ -169,6 +213,22 @@ begin Close; end; +procedure Tmainform.mnu_helpCheckForUpdatesClick(Sender: TObject); +var + OldItemIndex: integer; +begin + OldItemIndex := grp_Application.ItemIndex; + LazAutoUpdate1.ProjectType := auSourceForge; // can be auGitHubReleaseZip or auOther + LazAutoUpdate1.SFProjectname := 'lazautoupdate'; // Or GitHub properties + LazAutoUpdate1.UpdatesFolder := 'updates'; // Subfolder in repository + LazAutoUpdate1.VersionsININame := 'lauinstaller' + C_PFX + '.ini'; // as specified + LazAutoUpdate1.ZipfileName := 'lauinstaller' + C_PFX + '.zip'; // as specified + LazAutoUpdate1.AppFileWithPath := Application.Exename; + If NOT LazAutoUpdate1.AutoUpdate then + ConfigureLazAutoUpdate(OldItemIndex); // Restore properties + +end; + procedure Tmainform.ConfigureLazAutoUpdate(const AItemIndex: integer); begin // Note: This routine relies on a consistent naming convention for your @@ -176,7 +236,8 @@ begin case AItemIndex of 0: //Update Pack begin - LazAutoUpdate1.ProjectType := auSourceForge; // can be auGitHubReleaseZip or auOther + LazAutoUpdate1.ProjectType := auSourceForge; + // can be auGitHubReleaseZip or auOther LazAutoUpdate1.SFProjectname := 'lazautoupdate'; // Or GitHub properties LazAutoUpdate1.UpdatesFolder := 'updates'; // Subfolder in repository LazAutoUpdate1.VersionsININame := 'updatepack' + C_PFX + '.ini'; // as specified @@ -186,33 +247,39 @@ begin LazAutoUpdate1.AppFileWithPath := sDirectoryToInstallTo + DirectorySeparator + 'updatepack.exe'; {$ELSE} - LazAutoUpdate1.AppFileWithPath := sDirectoryToInstallTo + - DirectorySeparator + 'updatepack'; + LazAutoUpdate1.AppFileWithPath := + sDirectoryToInstallTo + DirectorySeparator + 'updatepack'; {$ENDIF} // Our responsibility to make the folder if not DirectoryExistsUTF8(sDirectoryToInstallTo) then ForceDirectoriesUTF8(sDirectoryToInstallTo); LazAutoUpdate1.Appversion := '0.0.0.0'; + LazAutoUpdate1.ShortCut.Category := scUtility; + LazAutoUpdate1.ShortCut.Target := LazAutoUpdate1.AppFileWithPath; + LazAutoUpdate1.ShortCut.ShortcutName := 'LazAutoUpdate Update Pack'; end; 1: // Test Application (GitHub) begin LazAutoUpdate1.ProjectType := auGitHubReleaseZip; LazAutoUpdate1.GitHubProjectname := 'lazarusccr'; LazAutoUpdate1.GitHubRepositoryName := 'TestApp'; - LazAutoUpdate1.GitHubBranchOrTag:= 'updates'; + LazAutoUpdate1.GitHubBranchOrTag := 'updates'; LazAutoUpdate1.UpdatesFolder := 'updates'; LazAutoUpdate1.VersionsININame := 'testapp' + C_PFX + '.ini'; LazAutoUpdate1.ZipfileName := 'testapp' + C_PFX + '.zip'; {$IFDEF WINDOWS} - LazAutoUpdate1.AppFileWithPath := sDirectoryToInstallTo + - DirectorySeparator + 'testapp' + C_PFX + '.exe'; + LazAutoUpdate1.AppFileWithPath := + sDirectoryToInstallTo + DirectorySeparator + 'testapp' + C_PFX + '.exe'; {$ELSE} - LazAutoUpdate1.AppFileWithPath := sDirectoryToInstallTo + - DirectorySeparator + 'testapp' + C_PFX; + LazAutoUpdate1.AppFileWithPath := + sDirectoryToInstallTo + DirectorySeparator + 'testapp' + C_PFX; {$ENDIF} if not DirectoryExistsUTF8(sDirectoryToInstallTo) then ForceDirectoriesUTF8(sDirectoryToInstallTo); LazAutoUpdate1.Appversion := '0.0.0.0'; + LazAutoUpdate1.ShortCut.Category := scUtility; + LazAutoUpdate1.ShortCut.Target := LazAutoUpdate1.AppFileWithPath; + LazAutoUpdate1.ShortCut.ShortcutName := 'LazAutoUpdate Test App'; end; 2: // Test Application (SourceForge) begin @@ -222,15 +289,18 @@ begin LazAutoUpdate1.VersionsININame := 'testapp' + C_PFX + '.ini'; LazAutoUpdate1.ZipfileName := 'testapp' + C_PFX + '.zip'; {$IFDEF WINDOWS} - LazAutoUpdate1.AppFileWithPath := sDirectoryToInstallTo + - DirectorySeparator + 'testapp' + C_PFX + '.exe'; + LazAutoUpdate1.AppFileWithPath := + sDirectoryToInstallTo + DirectorySeparator + 'testapp' + C_PFX + '.exe'; {$ELSE} - LazAutoUpdate1.AppFileWithPath := sDirectoryToInstallTo + - DirectorySeparator + 'testapp' + C_PFX; + LazAutoUpdate1.AppFileWithPath := + sDirectoryToInstallTo + DirectorySeparator + 'testapp' + C_PFX; {$ENDIF} if not DirectoryExistsUTF8(sDirectoryToInstallTo) then ForceDirectoriesUTF8(sDirectoryToInstallTo); LazAutoUpdate1.Appversion := '0.0.0.0'; + LazAutoUpdate1.ShortCut.Category := scUtility; + LazAutoUpdate1.ShortCut.Target := LazAutoUpdate1.AppFileWithPath; + LazAutoUpdate1.ShortCut.ShortcutName := 'LazAutoUpdate Test App'; end; 3: // Retro Ski Run begin @@ -240,15 +310,18 @@ begin LazAutoUpdate1.VersionsININame := 'ski' + C_PFX + '.ini'; LazAutoUpdate1.ZipfileName := 'ski' + C_PFX + '.zip'; {$IFDEF WINDOWS} - LazAutoUpdate1.AppFileWithPath := sDirectoryToInstallTo + - DirectorySeparator + 'ski' + C_PFX + '.exe'; + LazAutoUpdate1.AppFileWithPath := + sDirectoryToInstallTo + DirectorySeparator + 'ski' + C_PFX + '.exe'; {$ELSE} - LazAutoUpdate1.AppFileWithPath := sDirectoryToInstallTo + - DirectorySeparator + 'ski' + C_PFX; + LazAutoUpdate1.AppFileWithPath := + sDirectoryToInstallTo + DirectorySeparator + 'ski' + C_PFX; {$ENDIF} if not DirectoryExistsUTF8(sDirectoryToInstallTo) then ForceDirectoriesUTF8(sDirectoryToInstallTo); LazAutoUpdate1.Appversion := '0.0.0.0'; + LazAutoUpdate1.ShortCut.Category := scGame; + LazAutoUpdate1.ShortCut.Target := LazAutoUpdate1.AppFileWithPath; + LazAutoUpdate1.ShortCut.ShortcutName := 'Retro Ski Run'; end; end; end; diff --git a/components/lazautoupdate/latest_stable/ulazautoupdate.pas b/components/lazautoupdate/latest_stable/ulazautoupdate.pas index 5f192e387..00a1d0586 100644 --- a/components/lazautoupdate/latest_stable/ulazautoupdate.pas +++ b/components/lazautoupdate/latest_stable/ulazautoupdate.pas @@ -145,9 +145,9 @@ const 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: ?? + V0.3.8: Shortcut Menu items now created/deleted } - C_TLazAutoUpdateComponentVersion = '0.3.7.2'; + C_TLazAutoUpdateComponentVersion = '0.3.8'; C_TThreadedDownloadComponentVersion = '0.0.3.0'; { V0.0.1: Initial alpha @@ -352,7 +352,7 @@ type // Put in form.activate. Shows only if in ProgramDirectory then deletes it. Exits otherwise procedure ShowWhatsNewIfAvailable; // Checks for new version then shows dialogs to update - procedure AutoUpdate; + Function AutoUpdate:Boolean; // No dialogs - what it says on the tin. function SilentUpdate: boolean; // Used in SilentUpdate. Shells to local lauupdate(.exe) @@ -1184,12 +1184,12 @@ begin end; end; -procedure TLazAutoUpdate.AutoUpdate; +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 @@ -1231,9 +1231,12 @@ begin mtInformation, [mbOK], 0); end else + begin MessageDlg(fParentApplication.Title, rsThisApplicat, mtInformation, [mbOK], 0); + Result:=TRUE; + end; end; function TLazAutoUpdate.IsOnlineVersionNewer(const sznewINIPath: string): boolean; diff --git a/components/lazautoupdate/latest_stable/updates/lazautoupdate.zip b/components/lazautoupdate/latest_stable/updates/lazautoupdate.zip index db8904d07..a722363ec 100644 Binary files a/components/lazautoupdate/latest_stable/updates/lazautoupdate.zip and b/components/lazautoupdate/latest_stable/updates/lazautoupdate.zip differ diff --git a/components/lazautoupdate/latest_stable/updates/update_lazautoupdate.json b/components/lazautoupdate/latest_stable/updates/update_lazautoupdate.json index 4b98b1839..dc1b986e7 100644 --- a/components/lazautoupdate/latest_stable/updates/update_lazautoupdate.json +++ b/components/lazautoupdate/latest_stable/updates/update_lazautoupdate.json @@ -9,7 +9,7 @@ "ForceNotify" : false, "InternalVersion" : 1, "Name" : "lazupdate.lpk", - "Version" : "0.3.7.2" + "Version" : "0.3.8.0" } ] } diff --git a/components/lazautoupdate/latest_stable/ushortcut.pas b/components/lazautoupdate/latest_stable/ushortcut.pas index 6bf4e51e0..95d3c0ea9 100644 --- a/components/lazautoupdate/latest_stable/ushortcut.pas +++ b/components/lazautoupdate/latest_stable/ushortcut.pas @@ -176,21 +176,35 @@ begin ISLink.SetPath(PChar(Target)); ISLink.SetArguments(PChar(TargetArguments)); ISLink.SetWorkingDirectory(PChar(ExtractFilePath(Target))); - { - Not needed - ISLink.SetIconLocation(Pchar(ExtractFilePath(Target) + IconFileName),0); - } { Get the desktop location } SHGetSpecialFolderLocation(0, CSIDL_DESKTOPDIRECTORY, PIDL); SHGetPathFromIDList(PIDL, InFolder); + LinkName := IncludeTrailingPathDelimiter(InFolder) + ShortcutName + '.lnk'; - { Get rid of any existing shortcut first } - if not SysUtils.DeleteFile(LinkName) then AddToDebugString('Could not delete existing link ' + LinkName); - { Create the link } + {Create the link } IPFile.Save(PWChar(LinkName), False); + {Notify the shell} + SHChangeNotify(SHCNE_CREATE, SHCNF_PATH, PChar(LinkName), nil); + SHChangeNotify(SHCNE_UPDATEDIR, SHCNF_PATH or SHCNF_FLUSH, + PChar(ExtractFileDir(LinkName)), nil); + + {Menu Entry} + SHGetSpecialFolderLocation(0, CSIDL_PROGRAMS, PIDL); + SHGetPathFromIDList(PIDL, InFolder); + If Not DirectoryExistsUTF8(IncludeTrailingPathDelimiter(InFolder) + ShortcutName) then + ForceDirectoriesUTF8(IncludeTrailingPathDelimiter(InFolder) + ShortcutName); + LinkName := IncludeTrailingPathDelimiter(InFolder) + ShortcutName + DirectorySeparator + ShortcutName + '.lnk'; + { Get rid of any existing shortcut first } + if not SysUtils.DeleteFile(LinkName) then + AddToDebugString('Could not delete existing link ' + LinkName); + {Create the menu entry link } + IPFile.Save(PWChar(LinkName), False); + {Notify the shell} + SHChangeNotify(SHCNE_MKDIR, SHCNF_PATH, PChar(LinkName), nil) + finally // Not needed: FreeAndNil(IPFile); end; @@ -408,6 +422,23 @@ begin end else AddToDebugString('DeleteDesktopShortcut Failure: Unable to delete ' + LinkName); + { Get the menu location} + SHGetSpecialFolderLocation(0, CSIDL_PROGRAMS, PIDL); + SHGetPathFromIDList(PIDL, InFolder); + LinkName := IncludeTrailingPathDelimiter(InFolder) + ShortcutName + DirectorySeparator + ShortcutName + '.lnk'; + { Get rid of any existing shortcut first } + if SysUtils.DeleteFile(LinkName) then + begin + AddToDebugString('DeleteDesktopShortcut Success: Deleted ' + LinkName); + Result := True; + end + else + AddToDebugString('DeleteDesktopShortcut Failure: Unable to delete ' + LinkName); + If DirectoryExistsUTF8(IncludeTrailingPathDelimiter(InFolder) + ShortcutName) then + If RemoveDirUTF8(IncludeTrailingPathDelimiter(InFolder) + ShortcutName) then + AddToDebugString('DeleteDesktopShortcut Success: Deleted menu entry') + else + AddToDebugString('DeleteDesktopShortcut Failure: Unable to delete menu entry'); except AddToDebugString('Exception deleting ' + LinkName); // Eat the exception