\
MAKEMSI Installs...Samples Installed by MAKEMSISamples - Build New MSI/MSMTryMeLoadDirTreeMaintainingAttributes.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:
- TryMe.ver
- 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.7 $
; $Date: 17 Dec 2006 20:35:32 $
; $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.
;
; 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! --------------------------------------------
#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"'
#DefineRexx
#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 06.086) --------
;----------------------------------------------------------------------------
#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 ---
@@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);
;--- Need to do anything for this folder? ---------------------------
if @@Attrib <> 0 then
do
;--- Convert Attribute int (0-7) to number (and report) ---------
@@FoldAttr.0 = '' ;;A conversion table is easier than more complex code...
@@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'
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 & """"
;--- Get access to the folder object ----------------------------
on error resume next
CaDebug 0, "Get Folder object"
dim oFolder : set oFolder = oFS.GetFolder(FullDir)
dim ErrTxt
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]---
![[Bottom]](bottom.gif){kind=small}
![[Contents]](nav_contents.jpg){kind=small}
![[Prev]: TryMeWithFixedGuids.MM](prev.gif){kind=small}
![[Next]: TryMeCreateMergeModule.MM](next.gif){kind=small}
![[Top]](top.gif){kind=small}