Folder Attributes - Reapply at Install Time |
Windows Installer allows you to specify attributes for a file and so the MAKEMSI "file" and "files" commands have the "Attributes" and "CopyAttributes" parameters.
Unfortunately Windows Installer doesn't support folder attributes. This section demonstrates a "CopyAttributes" type behaviour for directories. We determine the attributes we want based on the build time source image(s) and apply these at installation time. As the "files" command doesn't recreate empty directories this sample also takes care of this issue.
The following breaks up the steps however the installed "TryMeLoadDirTreeMaintainingAttributes.MM" sample demonstrates the complete code.
EXAMPLE: Step 1: Determine Attributes At Build Time |
This command can be used multiple times if you have more than one image:
<$FolderAttributesExtract SourceRootDir="<$SourceRootDir>" DirKey="INSTALLDIR" CopyAttributes="ReadOnly or Hidden or System">
In the above command you supplied the root of the directory tree at both build and install time as well as specifying which attributes you were interested in.
EXAMPLE: Step 2: Apply Attributes At Install Time |
This command must be used once only after all attributes have been determined:
<$FolderAttributesApply>
The Supporting Code |
As this code is designed to be reused you would typically add it to your own configuration header file so that all projects that need it use the same copy (making bug fixing, testing and improvements much easier):
;---------------------------------------------------------------------------- ;--- Create Macros to allow folder attribute processing (ver 08.243) -------- ;---------------------------------------------------------------------------- #RexxVar '@@FoldAttCnt' = 0 #( '' #define FolderAttributesExtract ;--- Validate passed parameters ----------------------------------------- {$!:DirKey,SourceRootDir,CopyAttributes} ;--- Init code ---------------------------------------------------------- #ifndef @@GetFolderAttributes ;--- We must use "FolderAttributesApply" ---------------------------- #push "FolderAttributesApply.must.be.used.if.FolderAttributesExtract.is" ;--- Create a script which we need ---------------------------------- #define @@GetFolderAttributes <$MAKEMSI_NONCA_SCRIPT_DIR>\GetFolderAttributes.vbs #define @@AttributesPrefix oFS.Attributes=' ;;Used to parse redirected output of this program. Must not include double quotes! #define @@AttributesSuffix ' ;;Used to parse redirected output of this program. Must not include double quotes! #output "<$@@GetFolderAttributes>" ASIS ;;Don't care about date/time etc (so won't bother with the "FileMake" command) #( '<?NewLine>' ;--- Nice heading ----------------------------------------------- '========================================================== '=== Simple script used by the MAKEMSI script to obtain === '=== attributes (I didn't want to use attrib.exe). === '=== === '=== This script is built during MAKEMSI execution as I === '=== prefer all related bits of code together and can === '=== where required conditionally generated the output === '=== and refer to macros (product name, version etc). === '========================================================== <?NewLine> ;--- Init ------------------------------------------------------- option explicit <?SyntaxCheck> on error goto 0 'Die on error const ReadOnly = 1 const Hidden = 2 const System = 4 dim oFS : set oFS = CreateObject("Scripting.FileSystemObject") ;--- Get folder name -------------------------------------------- dim DirName if wscript.arguments.count <> 1 then Die "Expected one only parameter, not " & wscript.arguments.count else DirName = wscript.arguments(0) end if if not oFS.FolderExists(DirName) then Die "The folder """ & DirName & """ doesn't exist!" end if ;--- Now get the folder attributes ------------------------------ dim oFolder : set oFolder = oFS.GetFolder(DirName) dim Attrib : Attrib = oFolder.attributes ;--- Only care about some of the attributes --------------------- Attrib = Attrib and ({$CopyAttributes=^ReadOnly or Hidden or System^}) ;--- Return the answer ------------------------------------------ say "<$@@AttributesPrefix>" & Attrib & "<$@@AttributesSuffix>" ;--- Return success --------------------------------------------- wscript.quit 777 ;;RC Ignored - Windows has too many bugs to make this reliable <?NewLine> <?NewLine> '===================== sub Die(Reason) '===================== Say "ERROR: " & Reason wscript.quit 999 end sub <?NewLine> '===================== sub Say(This) '===================== wscript.echo This end sub #) #output #endif ;--- Do stuff ----------------------------------------------------------- #evaluate ^^ ^<$@@Rexx4FolderAttributesExtract {$?}>^ #) #DefineRexx '@@Rexx4FolderAttributesExtract' ;--- Init Generated Code -------------------------------------------- @@Vbs = '' ;--- Get List of directories ---------------------------------------- call Info 'Maintaining Folder Attributes for: "{$SourceRootDir}"' @@SourceDir = DirQueryExists('{$SourceRootDir}'); ;;Get full name if @@SourceDir = '' then error('The directory "{$SourceRootDir}" does not exist!'); @@SourceDirS = @@SourceDir || '\'; call Dirs4Mask @@SourceDirS || "*.*", "@@Dirs", "Y", "Y"; ;--- Work through directory list looking for folders with attributes --- @@WantEmpty = ToUpperCase( '{$KeepEmptyFolders='Y'}') <> 'N' @@TmpFile = FileGetTmpName('DIR_????.TMP'); do @@X = 1 to @@Dirs.0 ;--- Get full and relative Directory names ---------------------- @@FullDir = @@Dirs.@@X; @@RelDir = substr(@@FullDir, length(@@SourceDirS)+1) ;--- Run the VBSCRIPT I created above to get folder attributes --- call FileClose @@TmpFile, 'N'; call AddressCmd 'cscript.exe //NoLogo "<$@@GetFolderAttributes>" "' || @@FullDir || '" >"' || @@TmpFile || '" 2>&1', @@TmpFile; @@Contents = charin(@@TmpFile,, 999) call FileClose @@TmpFile; parse var @@Contents "<$@@AttributesPrefix>" @@Attrib "<$@@AttributesSuffix>" if @@Attrib = '' | DataType(@@Attrib, 'W') = 0 then error('Failed getting folder attributes for "' || @@FullDir || '"',, 'REASON', '~~~~~~', @@Contents); ;--- See if we need to do something for this folder ----------------- @@Special = @@Attrib <> 0 if @@WantEmpty then do ;--- We want to handle EMPTY folders ------------------------ if \ @@Special then do ;--- Not a special folder, so see if it has subdirectories --- call Dirs4Mask @@FullDir || "\*.*", "@@SubDirs", "N", "N"; if @@SubDirs.0 = 0 then do ;--- There are no subdirectories (so still looks "empty") --- call Files4Mask @@FullDir || "\*.*", "@@SubFiles", "N", "N"; if @@SubFiles.0 = 0 then @@Special = (1 = 1) ;;No subdirectories and no files end; end; end; ;--- Need to do anything for this folder? --------------------------- if @@Special then do ;--- A conversion table is easier than more complex code... ----- if @@WantEmpty then @@FoldAttr.0 = 'EMPTY FOLDER' else @@FoldAttr.0 = '?' ;;Shouldn't ever use this... @@FoldAttr.1 = 'Read Only' @@FoldAttr.2 = 'Hidden' @@FoldAttr.3 = 'Read Only + Hidden' @@FoldAttr.4 = 'System' @@FoldAttr.5 = 'Read Only + System' @@FoldAttr.6 = 'Hidden + System' @@FoldAttr.7 = 'Read Only + Hidden + System' ;--- Convert Attribute int (0-7) to number (and report) --------- call Info 'Folder "' || @@RelDir || '" <== ' || @@FoldAttr.@@Attrib ;--- Add to VBS code to handle this file -------------------- @@Vbs = @@Vbs || 'SetFolderAttributes BaseDir, "' || @@RelDir || '", ' || @@Attrib || '<?NewLine>' end; end; call FileDelete @@TmpFile, 'N'; ;--- Remember details --------------------------------------------------- @@FoldAttCnt = @@FoldAttCnt + 1; @@FoldAtt_DirKey.@@FoldAttCnt = '{$DirKey}'; @@FoldAtt_VbsCode.@@FoldAttCnt = @@Vbs; #DefineRexx #DefineRexx '@@Rexx2SetUpCaDataStructure' do @@r = 1 to @@FoldAttCnt; call value '@@CaDataSetFolderAttr.' || @@r || '.1', @@FoldAtt_DirKey.@@r; call value '@@CaDataSetFolderAttr.' || @@r || '.2', '[' || @@FoldAtt_DirKey.@@r || ']'; end; call value '@@CaDataSetFolderAttr.0', @@FoldAttCnt; #DefineRexx #( #define FolderAttributesApply ;--- Validate passed parameters ----------------------------------------- {$!:} ;---------------------------------------------------------------------------- ;--- Make sure we have work to do --------------------------------------- ;---------------------------------------------------------------------------- #if [@@FoldAttCnt = 0] #error ^You must use the "FolderAttributesExtract" macro at least once!^ #endif #pop "FolderAttributesApply.must.be.used.if.FolderAttributesExtract.is" ;---------------------------------------------------------------------------- ;--- Create VBSCRIPT based CA to set directory attributes ------------------- ;---------------------------------------------------------------------------- #data "@@CaDataSetFolderAttr" 2 #data #evaluate ^^ ^<$@@Rexx2SetUpCaDataStructure>^ <$VbsCa Binary="SetFolderAttributes.vbs" DATA="@@CaDataSetFolderAttr"> #( '<?NewLine>' dim oFS const ReadOnly = 1 const Hidden = 2 const System = 4 <$VbsCaEntry "Install"> ;--- Initialization ---------------------------------------------- set oFS = CaMkObject("Scripting.FileSystemObject") CaDebug 1, "Setting folder attributes for <??@@FoldAttCnt> directory tree(s)..." #{ for @@x = 1 to @@FoldAttCnt SetFolderAttributesForDirectoryKey_<??@@X>() #} set oFS = Nothing <$/VbsCaEntry> #{ for @@x = 1 to @@FoldAttCnt <?NewLine> '========================================================== sub SetFolderAttributesForDirectoryKey_<??@@X>() '========================================================== ;--- Initialization ---------------------------------------------- CaDebug 1, "Setting folder attributes for the directory key ""<??@@FoldAtt_DirKey.@@X>""" CaDebug 2, "Initializing" dim BaseDir : BaseDir = VbsCaCadGet("<??@@FoldAtt_DirKey.@@X>") ;--- Generate the previously worked out code --------------------- CaDebug 2, "Starting attribute setting for the directory key ""<??@@FoldAtt_DirKey.@@X>""" VbsCaLogInc 1 <??@@FoldAtt_VbsCode.@@X> VbsCaLogInc -1 CaDebug 1, "Completed setting attributes for ""<??@@FoldAtt_DirKey.@@X>""" end sub #} <?NewLine> '========================================================== sub SetFolderAttributes(BaseDir, RelDirName, AttributesBits) '========================================================== ;--- Get full name of folder ------------------------------------ CaDebug 2, "Updating attributes of """ & RelDirName & """ (" & AttributesBits & ")." VbsCaLogInc 1 dim FullDir : FullDir = BaseDir & RelDirName CaDebug 0, "Full folder name is """ & FullDir & """" ;--- Do we need to create an empty folder? ---------------------- if AttributesBits = 0 then CaDebug 0, "Recreating an empty folder" if oFS.FolderExists(FullDir) then CaDebug 0, "The empty folder already exists!" else oFS.CreateFolder FullDir dim ErrTxt if err.number <> 0 then ErrTxt = "Reason 0x" & hex(err.number) & " - " & err.description on error goto 0 VbsCaRaiseError "SetFolderAttributes()", "Failed recreating the empty folder """ & FullDir & """. " & ErrTxt end if end if end if ;--- Get access to the folder object ---------------------------- on error resume next CaDebug 0, "Get Folder object" dim oFolder : set oFolder = oFS.GetFolder(FullDir) if err.number <> 0 then ErrTxt = "Reason 0x" & hex(err.number) & " - " & err.description on error goto 0 VbsCaRaiseError "SetFolderAttributes()", "Failed accessing the folder """ & FullDir & """. " & ErrTxt end if ;--- Set required attributes ------------------------------------ CaDebug 0, "Setting attributes..." oFolder.Attributes = oFolder.Attributes or AttributesBits if err.number <> 0 then ErrTxt = "Reason 0x" & hex(err.number) & " - " & err.description on error goto 0 VbsCaRaiseError "SetFolderAttributes()", "Failed setting attributes on """ & RelDirName & """ (" & FolderAttributes & "). " & ErrTxt end if set oFolder = Nothing VbsCaLogInc -1 end sub #) <$/VbsCa> ;--- Must be scheduled after folders have been created! ----------------- <$VbsCaSetup Binary="SetFolderAttributes.vbs" Entry="Install" Seq="DuplicateFiles-" CONDITION=^<$VBSCA_CONDITION_INSTALL_ONLY>^ DATA="@@CaDataSetFolderAttr"> #)