TryMeLoadDirTreeMaintainingAttributes.MM |
This is one of the MAKEMSI samples which build a new MSI/MSM. This MSI makes use of these "TryMe.MM" files:
The following code demonstrates the process described in the "Folder Attributes - Reapply at Install Time" section of the manual.
;---------------------------------------------------------------------------- ; MODULE NAME: TryMeLoadDirTreeMaintainingAttributes.MM ; ; $Author: USER "Dennis" $ ; $Revision: 1.8 $ ; $Date: 30 Aug 2008 12:29:48 $ ; $Logfile: C:/DBAREIS/Projects.PVCS/Win32/MakeMsi/TryMeLoadDirTreeMaintainingAttributes.MM.pvcs $ ; ; DESCRIPTION ; ~~~~~~~~~~~ ; This sample loads up a directory tree and keeps any hidden and read-only ; attributes on files and folders. It will also create "empty folders". ; ; Windows Installer (and MAKEMSI) support file attributes but not folder ; hence the need for almost all the code below, if you didn't care about ; folder attributes then the "Files" command on its own will do this! ; ; Note that I put the fast but more likely (in the scheme of things) code ; to fail before the possibly very slow reliable code to minimise any delay ; before a "build" problem is detected. Where possible this is only "smart". ; ; Note that in the following script I actually create the source tree, this ; would not normally be part of a script (although you might do similar for ; a file or two). I have done it in this script as its a useful trick to ; demonstrate and means I don't have to maintain this examples source tree. ;---------------------------------------------------------------------------- ;---------------------------------------------------------------------------- ;--- Include MAKEMSI support (with my customisations and MSI branding) ------ ;---------------------------------------------------------------------------- #define VER_FILENAME.VER TryMe.Ver ;;I only want one VER file for all my samples! #include "ME.MMH" ;---------------------------------------------------------------------------- ;--- SCRIPT SETUP (YOU WOULD NEVER NORMALLY DO THIS YOURSELF) --------------- ;---------------------------------------------------------------------------- #define SourceRootDir .\SourceTree ;;Where is the development time image (to be updated before script run)? #if DirQueryExists('<$SourceRootDir>') = '' ;--- Lets only do this once! -------------------------------------------- #info ^Creating the TEST source directory...^ #define ContentsOfFile A Sample file. Created by: <$ProdInfo.ProductName> #DefineRexx '' ;--- Remove any existing read only attributes (ignore errors) ------- call AddressCmd 'attrib.exe -R "<$SourceRootDir>\SubDir.1r"' call AddressCmd 'attrib.exe -R "<$SourceRootDir>\SubDir.2\SubDir2.1\FileSubDir2-1r.TXT"' #DefineRexx <$FileMake "<$SourceRootDir>\File1InRoot.TXT" StateFile="<$SourceRootDir>.state\File1InRoot.TXT"> <$ContentsOfFile> <$/FileMake> <$FileMake "<$SourceRootDir>\File2InRoot.TXT" StateFile="<$SourceRootDir>.state\File2InRoot.TXT"> <$ContentsOfFile> <$/FileMake> <$FileMake "<$SourceRootDir>\SubDir.1r\FileSubDir1.TXT" StateFile="<$SourceRootDir>.state\SubDir.1\FileSubDir1.TXT"> <$ContentsOfFile> <$/FileMake> <$FileMake "<$SourceRootDir>\SubDir.2\FileSubDir2.TXT" StateFile="<$SourceRootDir>.state\SubDir.2\FileSubDir2.TXT"> <$ContentsOfFile> <$/FileMake> <$FileMake "<$SourceRootDir>\SubDir.2\SubDir2.1\FileSubDir2-1r.TXT" StateFile="<$SourceRootDir>.state\SubDir.2\SubDir2.1\FileSubDir2-1.TXT"> <$ContentsOfFile> <$/FileMake> #DefineRexx '' ;--- Set read only attribute on one file and one folder ------------- call AddressCmd 'attrib.exe +R "<$SourceRootDir>\SubDir.1r"' call AddressCmd 'attrib.exe +R "<$SourceRootDir>\SubDir.2\SubDir2.1\FileSubDir2-1r.TXT"' ;--- Make an empty folder ------------------------------------------- call AddressCmd 'MD "<$SourceRootDir>\SubDir.3\SubDir.3.1(WhichIsEmpty)"' #DefineRexx #info ^Finished Creating the TEST source directory...^ #endif ;---------------------------------------------------------------------------- ;--- Create INSTALLDIR (allow user to change it during install) ------------- ;---------------------------------------------------------------------------- <$DirectoryTree Key="INSTALLDIR" Dir="[ProgramFilesFolder]\AAA-<$ProdInfo.ProductName>" CHANGE="\" PrimaryFolder="Y"> ;-------------------------------------------------------------------------------------- ;--- Add the files (will create most or all folders - without "special" attributes) --- ;-------------------------------------------------------------------------------------- #( <$Files "<$SourceRootDir>\*.*" DestDir="INSTALLDIR" SubDir="TREE" CopyAttributes="Hidden ReadOnly System" > #) ;---[4Doco-FolderAttributesSupportingApplyAndExtractCode]--- ;---------------------------------------------------------------------------- ;--- 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"> #) ;---[4Doco-FolderAttributesSupportingApplyAndExtractCode]--- ;--- Get attribute details from the source directory tree ------------------- ;---[4Doco-FolderAttributesExtract]--- <$FolderAttributesExtract SourceRootDir="<$SourceRootDir>" DirKey="INSTALLDIR" CopyAttributes="ReadOnly or Hidden or System"> ;---[4Doco-FolderAttributesExtract]--- ;--- Apply folder attribute details we have gathered ------------------------ ;---[4Doco-FolderAttributesApply]--- <$FolderAttributesApply> ;---[4Doco-FolderAttributesApply]---