|
|
|
![[Bottom]](bottom.gif){kind=small}
![[Contents]](nav_contents.jpg){kind=small}
![[Prev]: Files In Use - ADD](prev.gif){kind=small}
![[Next]: Folder Customisation](next.gif){kind=small}
Tips and TricksFile and DirectoryFolder Attributes - Reapply at Install Time|
|
|
|
Tips and TricksFile and DirectoryFolder Attributes - Reapply at Install Time| 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">
#)
  |
 MAKEMSI© is (C)opyright Dennis Bareis 2003-2008 (All rights reserved). Thursday November 21 2019 at 5:39pm Visit MAKEMSI's Home Page | |
![[Top]](top.gif){kind=small}