Browse Source

Added constants {userpf} and {usercf}.

Martijn Laan 13 years ago
parent
commit
780e66f949
3 changed files with 46 additions and 3 deletions
  1. 2 2
      Projects/Compile.pas
  2. 43 1
      Projects/Main.pas
  3. 1 0
      whatsnew.htm

+ 2 - 2
Projects/Compile.pas

@@ -2773,13 +2773,13 @@ function TSetupCompiler.CheckConst(const S: String; const MinVersion: TSetupVers
   end;
   end;
 
 
 const
 const
-  Consts: array[0..36] of String = (
+  Consts: array[0..38] of String = (
     'src', 'srcexe', 'tmp', 'app', 'win', 'sys', 'sd', 'groupname', 'fonts',
     'src', 'srcexe', 'tmp', 'app', 'win', 'sys', 'sd', 'groupname', 'fonts',
     'hwnd', 'pf', 'pf32', 'pf64', 'cf', 'cf32', 'cf64', 'computername', 'dao',
     'hwnd', 'pf', 'pf32', 'pf64', 'cf', 'cf32', 'cf64', 'computername', 'dao',
     'cmd', 'username', 'wizardhwnd', 'sysuserinfoname', 'sysuserinfoorg',
     'cmd', 'username', 'wizardhwnd', 'sysuserinfoname', 'sysuserinfoorg',
     'userinfoname', 'userinfoorg', 'userinfoserial', 'uninstallexe',
     'userinfoname', 'userinfoorg', 'userinfoserial', 'uninstallexe',
     'language', 'syswow64', 'log', 'dotnet11', 'dotnet20', 'dotnet2032',
     'language', 'syswow64', 'log', 'dotnet11', 'dotnet20', 'dotnet2032',
-    'dotnet2064', 'dotnet40', 'dotnet4032', 'dotnet4064');
+    'dotnet2064', 'dotnet40', 'dotnet4032', 'dotnet4064', 'userpf', 'usercf');
   ShellFolderConsts: array[0..16] of String = (
   ShellFolderConsts: array[0..16] of String = (
     'group', 'userdesktop', 'userstartmenu', 'userprograms', 'userstartup',
     'group', 'userdesktop', 'userstartmenu', 'userprograms', 'userstartup',
     'commondesktop', 'commonstartmenu', 'commonprograms', 'commonstartup',
     'commondesktop', 'commonstartmenu', 'commonprograms', 'commonstartup',

+ 43 - 1
Projects/Main.pas

@@ -118,7 +118,8 @@ var
   { 'Constants' }
   { 'Constants' }
   SourceDir, TempInstallDir, WinDir, WinSystemDir, WinSysWow64Dir, SystemDrive,
   SourceDir, TempInstallDir, WinDir, WinSystemDir, WinSysWow64Dir, SystemDrive,
     ProgramFiles32Dir, CommonFiles32Dir, ProgramFiles64Dir, CommonFiles64Dir,
     ProgramFiles32Dir, CommonFiles32Dir, ProgramFiles64Dir, CommonFiles64Dir,
-    CmdFilename, SysUserInfoName, SysUserInfoOrg, UninstallExeFilename: String;
+    ProgramFilesUserDir, CommonFilesUserDir, CmdFilename, SysUserInfoName,
+    SysUserInfoOrg, UninstallExeFilename: String;
 
 
   { Uninstall 'constants' }
   { Uninstall 'constants' }
   UninstallExpandedAppId, UninstallExpandedApp, UninstallExpandedGroup,
   UninstallExpandedAppId, UninstallExpandedApp, UninstallExpandedGroup,
@@ -244,6 +245,7 @@ uses
   Msgs, MsgIDs, Install, InstFunc, InstFnc2, RedirFunc, PathFunc,
   Msgs, MsgIDs, Install, InstFunc, InstFnc2, RedirFunc, PathFunc,
   Compress, CompressZlib, bzlib, LZMADecomp, ArcFour, SetupEnt, SelLangForm,
   Compress, CompressZlib, bzlib, LZMADecomp, ArcFour, SetupEnt, SelLangForm,
   Wizard, DebugClient, VerInfo, Extract, FileClass, Logging, MD5, SHA1,
   Wizard, DebugClient, VerInfo, Extract, FileClass, Logging, MD5, SHA1,
+  {$IFNDEF Delphi3orHigher} OLE2, {$ELSE} ActiveX, {$ENDIF}
   SimpleExpression, Helper, SpawnClient, SpawnServer, LibFusion;
   SimpleExpression, Helper, SpawnClient, SpawnServer, LibFusion;
 
 
 {$R *.DFM}
 {$R *.DFM}
@@ -254,6 +256,8 @@ var
   SHFolderDLLHandle: HMODULE;
   SHFolderDLLHandle: HMODULE;
   SHGetFolderPathFunc: function(hwndOwner: HWND; nFolder: Integer;
   SHGetFolderPathFunc: function(hwndOwner: HWND; nFolder: Integer;
     hToken: THandle; dwFlags: DWORD; pszPath: PChar): HRESULT; stdcall;
     hToken: THandle; dwFlags: DWORD; pszPath: PChar): HRESULT; stdcall;
+  SHGetKnownFolderPathFunc: function(const rfid: TGUID; dwFlags: DWORD; hToken: THandle;
+    var ppszPath: PWideChar): HRESULT; stdcall;
 
 
   DecompressorDLLHandle: HMODULE;
   DecompressorDLLHandle: HMODULE;
   DecryptDLLHandle: HMODULE;
   DecryptDLLHandle: HMODULE;
@@ -998,12 +1002,24 @@ begin
   else if Cnst = 'srcexe' then Result := SetupLdrOriginalFilename
   else if Cnst = 'srcexe' then Result := SetupLdrOriginalFilename
   else if Cnst = 'tmp' then Result := TempInstallDir
   else if Cnst = 'tmp' then Result := TempInstallDir
   else if Cnst = 'sd' then Result := SystemDrive
   else if Cnst = 'sd' then Result := SystemDrive
+  else if Cnst = 'userpf' then begin
+    if ProgramFilesUserDir = '' then
+      Result := ProgramFilesUserDir
+    else
+      Result := ExpandConst('{localappdata}\Programs'); { supply default, same as Window 7 and newer }
+  end
   else if Cnst = 'pf' then begin
   else if Cnst = 'pf' then begin
     if Is64BitInstallMode then
     if Is64BitInstallMode then
       Result := ProgramFiles64Dir
       Result := ProgramFiles64Dir
     else
     else
       Result := ProgramFiles32Dir;
       Result := ProgramFiles32Dir;
   end
   end
+  else if Cnst = 'usercf' then begin
+    if CommonFilesUserDir <> '' then
+      Result := CommonFilesUserDir
+    else
+      Result := ExpandConst('{localappdata}\Programs\Common'); { supply default, same as Window 7 and newer }
+  end
   else if Cnst = 'cf' then begin
   else if Cnst = 'cf' then begin
     if Is64BitInstallMode then
     if Is64BitInstallMode then
       Result := CommonFiles64Dir
       Result := CommonFiles64Dir
@@ -1236,6 +1252,12 @@ procedure InitMainNonSHFolderConsts;
     end;
     end;
   end;
   end;
 
 
+const
+  FOLDERID_UserProgramFiles: TGUID = (D1:$5CD7AEE2; D2:$2219; D3:$4A67; D4:($B8,$5D,$6C,$9C,$E1,$56,$60,$CB));
+  FOLDERID_UserProgramFilesCommon: TGUID = (D1:$BCBD3057; D2:$CA5C; D3:$4622; D4:($B4,$2D,$BC,$56,$DB,$0A,$E5,$16));
+  KF_FLAG_CREATE = $00008000;
+var
+  Path: PWideChar;
 begin
 begin
   { Read Windows and Windows System dirs }
   { Read Windows and Windows System dirs }
   WinDir := GetWinDir;
   WinDir := GetWinDir;
@@ -1272,6 +1294,24 @@ begin
       InternalError('Failed to get path of 64-bit Common Files directory');
       InternalError('Failed to get path of 64-bit Common Files directory');
   end;
   end;
 
 
+  { Get per-user Program Files and Common Files dirs (requires Windows 7 or newer) }
+  if Assigned(SHGetKnownFolderPathFunc) and (WindowsVersion shr 16 >= $0601) then begin
+    if SHGetKnownFolderPathFunc(FOLDERID_UserProgramFiles, KF_FLAG_CREATE, 0, Path) = S_OK then begin
+      try
+        ProgramFilesUserDir := WideCharToString(Path);
+      finally
+        CoTaskMemFree(Path);
+      end;
+    end;
+    if SHGetKnownFolderPathFunc(FOLDERID_UserProgramFilesCommon, KF_FLAG_CREATE, 0, Path) = S_OK then begin
+      try
+        CommonFilesUserDir := WideCharToString(Path);
+      finally
+        CoTaskMemFree(Path);
+      end;
+    end;
+  end;
+
   { Get path of command interpreter }
   { Get path of command interpreter }
   if IsNT then
   if IsNT then
     CmdFilename := AddBackslash(WinSystemDir) + 'cmd.exe'
     CmdFilename := AddBackslash(WinSystemDir) + 'cmd.exe'
@@ -4243,6 +4283,8 @@ initialization
   DeleteFilesAfterInstallList := TStringList.Create;
   DeleteFilesAfterInstallList := TStringList.Create;
   DeleteDirsAfterInstallList := TStringList.Create;
   DeleteDirsAfterInstallList := TStringList.Create;
   CloseApplicationsFilterList := TStringList.Create;
   CloseApplicationsFilterList := TStringList.Create;
+  SHGetKnownFolderPathFunc := GetProcAddress(SafeLoadLibrary(shell32,
+    SEM_NOOPENFILEERRORBOX), 'SHGetKnownFolderPath');
 
 
 finalization
 finalization
   FreeAndNil(WizardImage);
   FreeAndNil(WizardImage);

+ 1 - 0
whatsnew.htm

@@ -29,6 +29,7 @@ For conditions of distribution and use, see <a href="http://www.jrsoftware.org/f
 <p><a name="5.5.2"></a><span class="ver">5.5.2-dev </span><span class="date">(?)</span></p>
 <p><a name="5.5.2"></a><span class="ver">5.5.2-dev </span><span class="date">(?)</span></p>
 <ul>
 <ul>
 <li>Added the Windows 8 "compatibility" section to the various manifest resources used by Inno Setup.</li>
 <li>Added the Windows 8 "compatibility" section to the various manifest resources used by Inno Setup.</li>
+<li>Added constants <tt>{userpf}</tt> and <tt>{usercf}</tt>.</li>
 <li>Minor tweaks.</li>
 <li>Minor tweaks.</li>
 </ul>
 </ul>