MAKEMSI quickly and reliably creates MSI files in a non-programmatic way
Have your say! Join the MAKEMSI discussion list or view archive! Suggest improvements. No question too simple or too complex.
[Bottom][Contents][Prev]: Files In Use - ADD[Next]: Folder Customisation
Have your say! Join the MAKEMSI discussion list or view archive! Suggest improvements. No question too simple or too complex.
\->Tips and Tricks->File and Directory->Folder 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">
#)


Microsoft awarded me an MVP (Most Valuable Professional award) in 2004, 2005, 2006, 2007, 2008 & 2009 for the Windows SDK (Windows Installer) area.Please email me any feedback, additional information or corrections.
See this page online (look for updates)

[Top][Contents][Prev]: Files In Use - ADD[Next]: Folder Customisation


MAKEMSI© is (C)opyright Dennis Bareis 2003-2008 (All rights reserved).
Friday October 13 2017 at 2:08pm
Visit MAKEMSI's Home Page
Microsoft awarded me an MVP (Most Valuable Professional award) in 2004, 2005, 2006, 2007, 2008 & 2009 for the Windows SDK (Windows Installer) area.