Merge remote-tracking branch 'miniak/preventpinning'

Projects/Compile.pas

@@ -5040,10 +5040,10 @@ const
     (Name: ParamCommonAfterInstall; Flags: []),
     (Name: ParamCommonMinVersion; Flags: []),
     (Name: ParamCommonOnlyBelowVersion; Flags: []));
-  Flags: array[0..8] of PChar = (
+  Flags: array[0..9] of PChar = (
     'uninsneveruninstall', 'runminimized', 'createonlyiffileexists',
     'useapppaths', 'closeonexit', 'dontcloseonexit', 'runmaximized',
-    'foldershortcut', 'excludefromshowinnewinstall');
+    'foldershortcut', 'excludefromshowinnewinstall', 'preventpinning');
 var
   Values: array[TParam] of TParamValue;
   NewIconEntry: PSetupIconEntry;
@@ -5075,6 +5075,7 @@ begin
           6: ShowCmd := SW_SHOWMAXIMIZED;
           7: Include(Options, ioFolderShortcut);
           8: Include(Options, ioExcludeFromShowInNewInstall);
+          9: Include(Options, ioPreventPinning);
         end;
 
       { Name }

Projects/InstFnc2.pas

@@ -18,7 +18,7 @@ interface
 function CreateShellLink(const Filename, Description, ShortcutTo, Parameters,
   WorkingDir, IconFilename: String; const IconIndex, ShowCmd: Integer;
   const HotKey: Word; FolderShortcut: Boolean; const AppUserModelID: String;
-  const ExcludeFromShowInNewInstall: Boolean): String;
+  const ExcludeFromShowInNewInstall: Boolean, const PreventPinning: Boolean): String;
 procedure RegisterTypeLibrary(const Filename: String);
 procedure UnregisterTypeLibrary(const Filename: String);
 function UnpinShellLink(const Filename: String): Boolean;
@@ -149,7 +149,7 @@ type
 function CreateShellLink(const Filename, Description, ShortcutTo, Parameters,
   WorkingDir, IconFilename: String; const IconIndex, ShowCmd: Integer;
   const HotKey: Word; FolderShortcut: Boolean; const AppUserModelID: String;
-  const ExcludeFromShowInNewInstall: Boolean): String;
+  const ExcludeFromShowInNewInstall: Boolean, const PreventPinning: Boolean): String;
 { Creates a lnk file named Filename, with a description of Description, with a
   HotKey hotkey, which points to ShortcutTo.
   NOTE! If you want to copy this procedure for use in your own application
@@ -166,6 +166,9 @@ const
   PKEY_AppUserModel_ExcludeFromShowInNewInstall: TPropertyKey = (
     fmtid: (D1:$9F4C2855; D2:$9F79; D3:$4B39; D4:($A8,$D0,$E1,$D4,$2D,$E1,$D5,$F3));
     pid: 8);
+  PKEY_AppUserModel_PreventPinning: TPropertyKey = (
+    fmtid: (D1:$9F4C2855; D2:$9F79; D3:$4B39; D4:($A8,$D0,$E1,$D4,$2D,$E1,$D5,$F3));
+    pid: 9);
 
 {$IFNDEF Delphi3OrHigher}
 var
@@ -209,7 +212,7 @@ begin
 
     { Note: Vista and newer support IPropertyStore but Vista errors if you try to
       commit a PKEY_AppUserModel_ID, so avoid setting the property on Vista. }
-    if IsWindows7 and ((AppUserModelID <> '') or ExcludeFromShowInNewInstall) then begin
+    if IsWindows7 and ((AppUserModelID <> '') or ExcludeFromShowInNewInstall or PreventPinning) then begin
       OleResult := SL.QueryInterface(IID_IPropertyStore, PS);
       if OleResult <> S_OK then
         RaiseOleError('IShellLink::QueryInterface(IID_IPropertyStore)', OleResult);
@@ -233,6 +236,13 @@ begin
         if OleResult <> S_OK then
           RaiseOleError('IPropertyStore::SetValue(PKEY_AppUserModel_ExcludeFromShowInNewInstall)', OleResult);
       end;
+      if PreventPinning then begin
+        PV.vt := VT_BOOL;
+        PV.vbool := True;
+        OleResult := PS.SetValue(PKEY_AppUserModel_PreventPinning, PV);
+        if OleResult <> S_OK then
+          RaiseOleError('IPropertyStore::SetValue(PKEY_AppUserModel_PreventPinning)', OleResult);
+      end;
       OleResult := PS.Commit;
       if OleResult <> S_OK then
         RaiseOleError('IPropertyStore::Commit', OleResult);
@@ -303,7 +313,7 @@ begin
 
   { Note: Vista and newer support IPropertyStore but Vista errors if you try to
     commit a PKEY_AppUserModel_ID, so avoid setting the property on Vista. }
-  if IsWindows7 and ((AppUserModelID <> '') or ExcludeFromShowInNewInstall) then begin
+  if IsWindows7 and ((AppUserModelID <> '') or ExcludeFromShowInNewInstall or PreventPinning) then begin
     PS := Obj as IPropertyStore;
     if AppUserModelID <> '' then begin
       WideAppUserModelID := AppUserModelID;
@@ -319,7 +329,14 @@ begin
       OleResult := PS.SetValue(PKEY_AppUserModel_ExcludeFromShowInNewInstall, PV);
       if OleResult <> S_OK then
         RaiseOleError('IPropertyStore::SetValue(PKEY_AppUserModel_ExcludeFromShowInNewInstall)', OleResult);
-    end;    
+    end;
+    if PreventPinning then begin
+      PV.vt := VT_BOOL;
+      PV.boolVal := True;
+      OleResult := PS.SetValue(PKEY_AppUserModel_PreventPinning, PV);
+      if OleResult <> S_OK then
+        RaiseOleError('IPropertyStore::SetValue(PKEY_AppUserModel_PreventPinning)', OleResult);
+    end;
     OleResult := PS.Commit;
     if OleResult <> S_OK then
       RaiseOleError('IPropertyStore::Commit', OleResult);

Projects/Install.pas

@@ -1728,7 +1728,8 @@ var
       WorkingDir, IconFilename: String; const IconIndex, ShowCmd: Integer;
       const NeverUninstall: Boolean; const CloseOnExit: TSetupIconCloseOnExit;
       const HotKey: Word; FolderShortcut: Boolean;
-      const AppUserModelID: String; const ExcludeFromShowInNewInstall: Boolean);
+      const AppUserModelID: String; const ExcludeFromShowInNewInstall: Boolean;
+      const PreventPinning: Boolean);
     var
       BeginsWithGroup: Boolean;
       LinkFilename, PifFilename, UrlFilename, DirFilename, ProbableFilename,
@@ -1782,7 +1783,8 @@ var
           environment-variable strings (e.g. %SystemRoot%\...) }
         ResultingFilename := CreateShellLink(LinkFilename, Description, Path,
           Parameters, WorkingDir, IconFilename, IconIndex, ShowCmd, HotKey,
-          FolderShortcut, AppUserModelID, ExcludeFromShowInNewInstall);
+          FolderShortcut, AppUserModelID, ExcludeFromShowInNewInstall,
+          PreventPinning);
         FolderShortcutCreated := FolderShortcut and DirExists(ResultingFilename);
 
         { If a .pif file was created, apply the "Close on exit" setting }
@@ -1876,7 +1878,8 @@ var
                 ExpandConst(IconFilename), IconIndex, ShowCmd,
                 ioUninsNeverUninstall in Options, CloseOnExit, HotKey,
                 ioFolderShortcut in Options, ExpandConst(AppUserModelID),
-                ioExcludeFromShowInNewInstall in Options);
+                ioExcludeFromShowInNewInstall in Options,
+                ioPreventPinning in Options);
             NotifyAfterInstallEntry(AfterInstall);
           end;
         end;

Projects/Struct.pas

@@ -268,7 +268,8 @@ type
     CloseOnExit: TSetupIconCloseOnExit;
     HotKey: Word;
     Options: set of (ioUninsNeverUninstall, ioCreateOnlyIfFileExists,
-      ioUseAppPaths, ioFolderShortcut, ioExcludeFromShowInNewInstall);
+      ioUseAppPaths, ioFolderShortcut, ioExcludeFromShowInNewInstall,
+      ioPreventPinning);
   end;
 const
   SetupIniEntryStrings = 10;