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]: TryMeWithFixedGuids.MM[Next]: TryMeCreateMergeModule.MM
Have your say! Join the MAKEMSI discussion list or view archive! Suggest improvements. No question too simple or too complex.
\->MAKEMSI Installs...->Samples Installed by MAKEMSI->Samples - Build New MSI/MSM->TryMeLoadDirTreeMaintainingAttributes.MM

TryMeLoadDirTreeMaintainingAttributes.MM

This is one of the MAKEMSI samples which build a new MSI/MSM. This MSI makes use of these "TryMe.MM" files:

  1. TryMe.ver
  2. TryMe.rtf

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]---


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]: TryMeWithFixedGuids.MM[Next]: TryMeCreateMergeModule.MM


MAKEMSI© is (C)opyright Dennis Bareis 2003-2008 (All rights reserved).
Sunday August 13 2017 at 2:39pm
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.