Created
January 27, 2022 18:35
-
-
Save NickETH/acf4e01124a20cef0d45e0922e058fcb to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
' Windows Installer utility to generate file cabinets from MSI database | |
' For use with Windows Scripting Host, CScript.exe or WScript.exe | |
' Copyright (c) Microsoft Corporation. All rights reserved. | |
' Demonstrates the access to install engine and actions | |
' Has maximum CompressionLevel set. See Line 173 | |
' No MaxDiskSize, cabSize = "0". See Line 71 | |
' Extended with the MaxFilesPerCab option (3rd). | |
' If you need the 4th argument without Cab splitting, | |
' set the 3rd argument to bigger number than the highest file sequence. | |
Option Explicit | |
' FileSystemObject.CreateTextFile and FileSystemObject.OpenTextFile | |
Const OpenAsASCII = 0 | |
Const OpenAsUnicode = -1 | |
' FileSystemObject.CreateTextFile | |
Const OverwriteIfExist = -1 | |
Const FailIfExist = 0 | |
' FileSystemObject.OpenTextFile | |
Const OpenAsDefault = -2 | |
Const CreateIfNotExist = -1 | |
Const FailIfNotExist = 0 | |
Const ForReading = 1 | |
Const ForWriting = 2 | |
Const ForAppending = 8 | |
Const msiOpenDatabaseModeReadOnly = 0 | |
Const msiOpenDatabaseModeTransact = 1 | |
Const msiViewModifyInsert = 1 | |
Const msiViewModifyUpdate = 2 | |
Const msiViewModifyAssign = 3 | |
Const msiViewModifyReplace = 4 | |
Const msiViewModifyDelete = 6 | |
Const msiUILevelNone = 2 | |
Const msiRunModeSourceShortNames = 9 | |
Const msidbFileAttributesNoncompressed = &h00002000 | |
Dim argCount:argCount = Wscript.Arguments.Count | |
Dim iArg:iArg = 0 | |
If argCount > 0 Then If InStr(1, Wscript.Arguments(0), "?", vbTextCompare) > 0 Then argCount = 0 | |
If (argCount < 2) Then | |
Wscript.Echo "Windows Installer utility to generate compressed file cabinets from MSI database" &_ | |
vbNewLine & " The 1st argument is the path to MSI database, at the source file root" &_ | |
vbNewLine & " The 2nd argument is the base name used for the generated files (DDF, INF, RPT)" &_ | |
vbNewLine & " The 3rd argument can optionally specify the maximum files per CAB" &_ | |
vbNewLine & " The 4th argument can optionally specify separate source location from the MSI" &_ | |
vbNewLine & " The following options may be specified at any point on the command line" &_ | |
vbNewLine & " /L to use LZX compression instead of MSZIP" &_ | |
vbNewLine & " /F to limit cabinet size to 1.44 MB floppy size rather than CD" &_ | |
vbNewLine & " /C to run compression, else only generates the .DDF file" &_ | |
vbNewLine & " /U to update the MSI database to reference the generated cabinet" &_ | |
vbNewLine & " /E to embed the cabinet file in the installer package as a stream" &_ | |
vbNewLine & " /S to sequence number file table, ordered by directories" &_ | |
vbNewLine & " /R to revert to non-cabinet install, removes cabinet if /E specified" &_ | |
vbNewLine & " Notes:" &_ | |
vbNewLine & " In order to generate a cabinet, MAKECAB.EXE must be on the PATH" &_ | |
vbNewLine & " base name used for files and cabinet stream is case-sensitive" &_ | |
vbNewLine & " If source type set to compressed, all files will be opened at the root" &_ | |
vbNewLine & " (The /R option removes the compressed bit - SummaryInfo property 15 & 2)" &_ | |
vbNewLine & " To replace an embedded cabinet, include the options: /R /C /U /E" &_ | |
vbNewLine & " Does not handle updating of Media table to handle multiple cabinets" &_ | |
vbNewLine &_ | |
vbNewLine & "Copyright (C) Microsoft Corporation. All rights reserved." | |
Wscript.Quit 1 | |
End If | |
' Get argument values, processing any option flags | |
'Dim MaxFilesPerCab : MaxFilesPerCab = 0 | |
Dim compressType : compressType = "MSZIP" | |
Dim cabSize : cabSize = "0" | |
Dim makeCab : makeCab = False | |
Dim embedCab : embedCab = False | |
Dim updateMsi : updateMsi = False | |
Dim sequenceFile : sequenceFile = False | |
Dim removeCab : removeCab = False | |
Dim databasePath : databasePath = NextArgument | |
Dim baseName : baseName = NextArgument | |
Dim MaxFilesPerCab : MaxFilesPerCab = CInt(NextArgument) | |
Dim sourceFolder : sourceFolder = NextArgument | |
Wscript.Echo "MaxFiles1 " & MaxFilesPerCab | |
If Not IsEmpty(NextArgument) Then Fail "More than 4 arguments supplied" ' process any trailing options | |
If Len(baseName) < 1 Or Len(baseName) > 8 Then Fail "Base file name must be from 1 to 8 characters" | |
If Not IsEmpty(sourceFolder) And Right(sourceFolder, 1) <> "\" Then sourceFolder = sourceFolder & "\" | |
Dim cabFile : cabFile = baseName & ".CAB" | |
Dim cabName : cabName = cabFile : If embedCab Then cabName = "#" & cabName | |
If Not MaxFilesPerCab >= 0 Then MaxFilesPerCab = 0 | |
'Wscript.Echo "MaxFiles2 " & MaxFilesPerCab | |
' Connect to Windows Installer object | |
On Error Resume Next | |
Dim installer : Set installer = Nothing | |
Set installer = Wscript.CreateObject("WindowsInstaller.Installer") : CheckError | |
' Open database | |
Dim database, openMode, view, record, updateMode, sumInfo, sequence, lastSequence | |
If updateMsi Or sequenceFile Or removeCab Then openMode = msiOpenDatabaseModeTransact Else openMode = msiOpenDatabaseModeReadOnly | |
Set database = installer.OpenDatabase(databasePath, openMode) : CheckError | |
' Remove existing cabinet(s) and revert to source tree install if options specified | |
If removeCab Then | |
Set view = database.OpenView("SELECT DiskId, LastSequence, Cabinet FROM Media ORDER BY DiskId") : CheckError | |
view.Execute : CheckError | |
updateMode = msiViewModifyUpdate | |
Set record = view.Fetch : CheckError | |
If Not record Is Nothing Then ' Media table not empty | |
If Not record.IsNull(3) Then | |
If record.StringData(3) <> cabName Then Wscript.Echo "Warning, cabinet name in media table, " & record.StringData(3) & " does not match " & cabName | |
record.StringData(3) = Empty | |
End If | |
record.IntegerData(2) = 9999 ' in case of multiple cabinets, force all files from 1st media | |
view.Modify msiViewModifyUpdate, record : CheckError | |
Do | |
Set record = view.Fetch : CheckError | |
If record Is Nothing Then Exit Do | |
view.Modify msiViewModifyDelete, record : CheckError 'remove other cabinet records | |
Loop | |
End If | |
Set sumInfo = database.SummaryInformation(3) : CheckError | |
sumInfo.Property(11) = Now | |
sumInfo.Property(13) = Now | |
sumInfo.Property(15) = sumInfo.Property(15) And Not 2 | |
sumInfo.Persist | |
Set view = database.OpenView("SELECT `Name`,`Data` FROM _Streams WHERE `Name`= '" & cabFile & "'") : CheckError | |
view.Execute : CheckError | |
Set record = view.Fetch | |
If record Is Nothing Then | |
Wscript.Echo "Warning, cabinet stream not found in package: " & cabFile | |
Else | |
view.Modify msiViewModifyDelete, record : CheckError | |
End If | |
Set sumInfo = Nothing ' must release stream | |
database.Commit : CheckError | |
If Not updateMsi Then Wscript.Quit 0 | |
End If | |
' Create an install session and execute actions in order to perform directory resolution | |
installer.UILevel = msiUILevelNone | |
Dim session : Set session = installer.OpenPackage(database,1) : If Err <> 0 Then Fail "Database: " & databasePath & ". Invalid installer package format" | |
Dim shortNames : shortNames = session.Mode(msiRunModeSourceShortNames) : CheckError | |
If Not IsEmpty(sourceFolder) Then session.Property("OriginalDatabase") = sourceFolder : CheckError | |
Dim stat : stat = session.DoAction("CostInitialize") : CheckError | |
If stat <> 1 Then Fail "CostInitialize failed, returned " & stat | |
' Check for non-cabinet files to avoid sequence number collisions | |
lastSequence = 0 | |
If sequenceFile Then | |
Set view = database.OpenView("SELECT Sequence,Attributes FROM File") : CheckError | |
view.Execute : CheckError | |
Do | |
Set record = view.Fetch : CheckError | |
If record Is Nothing Then Exit Do | |
sequence = record.IntegerData(1) | |
If (record.IntegerData(2) And msidbFileAttributesNoncompressed) <> 0 And sequence > lastSequence Then lastSequence = sequence | |
Loop | |
End If | |
' Join File table to Component table in order to find directories | |
Dim orderBy : If sequenceFile Then orderBy = "Directory_" Else orderBy = "Sequence" | |
Set view = database.OpenView("SELECT File,FileName,Directory_,Sequence,File.Attributes FROM File,Component WHERE Component_=Component ORDER BY " & orderBy) : CheckError | |
view.Execute : CheckError | |
' Create DDF file and write header properties | |
Dim FileSys : Set FileSys = CreateObject("Scripting.FileSystemObject") : CheckError | |
Dim outStream : Set outStream = FileSys.CreateTextFile(baseName & ".DDF", OverwriteIfExist, OpenAsASCII) : CheckError | |
outStream.WriteLine "; Generated from " & databasePath & " on " & Now | |
outStream.WriteLine ".Set CabinetNameTemplate=" & baseName & "*.CAB" | |
'outStream.WriteLine ".Set CabinetName1=" & cabFile | |
outStream.WriteLine ".Set ReservePerCabinetSize=8" | |
outStream.WriteLine ".Set MaxDiskSize=" & cabSize | |
outStream.WriteLine ".Set CompressionType=" & compressType | |
outStream.WriteLine ".Set InfFileLineFormat=(*disk#*) *file#*: *file* = *Size*" | |
outStream.WriteLine ".Set InfFileName=" & baseName & ".INF" | |
outStream.WriteLine ".Set RptFileName=" & baseName & ".RPT" | |
outStream.WriteLine ".Set InfHeader=" | |
outStream.WriteLine ".Set InfFooter=" | |
outStream.WriteLine ".Set DiskDirectoryTemplate=." | |
outStream.WriteLine ".Set CompressionLevel=7" | |
outStream.WriteLine ".Set CompressionMemory=21" | |
outStream.WriteLine ".Set Compress=ON" | |
outStream.WriteLine ".Set Cabinet=ON" | |
' Fetch each file and request the source path, then verify the source path | |
Dim fileKey, fileName, folder, sourcePath, delim, message, attributes, MediaTableRows(), CabFileBreaker | |
REDIM MediaTableRows(0) | |
CabFileBreaker = MaxFilesPerCab | |
'Wscript.Echo "CabFileBreaker: " & CabFileBreaker | |
Do | |
Set record = view.Fetch : CheckError | |
If record Is Nothing Then Exit Do | |
fileKey = record.StringData(1) | |
fileName = record.StringData(2) | |
folder = record.StringData(3) | |
sequence = record.IntegerData(4) | |
attributes = record.IntegerData(5) | |
If (attributes And msidbFileAttributesNoncompressed) = 0 Then | |
If sequence <= lastSequence Then | |
If Not sequenceFile Then Fail "Duplicate sequence numbers in File table, use /S option" | |
sequence = lastSequence + 1 | |
record.IntegerData(4) = sequence | |
view.Modify msiViewModifyUpdate, record | |
End If | |
lastSequence = sequence | |
delim = InStr(1, fileName, "|", vbTextCompare) | |
If delim <> 0 Then | |
If shortNames Then fileName = Left(fileName, delim-1) Else fileName = Right(fileName, Len(fileName) - delim) | |
End If | |
sourcePath = session.SourcePath(folder) & fileName | |
outStream.WriteLine """" & sourcePath & """" & " " & fileKey | |
If installer.FileAttributes(sourcePath) = -1 Then message = message & vbNewLine & sourcePath | |
'Wscript.Echo "sequence: " & sequence | |
If CabFileBreaker = sequence Then | |
outStream.WriteLine ".New Cabinet ; Start a new cabinet" | |
MediaTableRows(ubound(MediaTableRows)) = sequence | |
REDIM PRESERVE MediaTableRows(ubound(MediaTableRows)+1) | |
CabFileBreaker = CabFileBreaker + MaxFilesPerCab | |
'Wscript.Echo "Inside Breaker: " & sequence | |
End If | |
MediaTableRows(ubound(MediaTableRows)) = lastSequence | |
End If | |
Loop | |
outStream.Close | |
REM Wscript.Echo "SourceDir = " & session.Property("SourceDir") | |
If Not IsEmpty(message) Then Fail "The following files were not available:" & message | |
' Generate compressed file cabinet | |
If makeCab Then | |
Dim WshShell : Set WshShell = Wscript.CreateObject("Wscript.Shell") : CheckError | |
Dim cabStat : cabStat = WshShell.Run("MakeCab.exe /f " & baseName & ".DDF", 7, True) : CheckError | |
If cabStat <> 0 Then Fail "MAKECAB.EXE failed, possibly could not find source files, or invalid DDF format" | |
End If | |
' Update Media table and SummaryInformation if requested | |
Dim i, CabId, NewFlag, CabfileName | |
If updateMsi Then | |
If embedCab Then | |
CabfileName = "#" & baseName | |
Else | |
CabfileName = baseName | |
End If | |
Set view = database.OpenView("SELECT DiskId, LastSequence, Cabinet FROM Media ORDER BY DiskId") : CheckError | |
view.Execute : CheckError | |
For i = 0 to ubound(MediaTableRows) | |
updateMode = msiViewModifyUpdate | |
CabId = (i+1) | |
'Wscript.Echo MediaTableRows(i) & " CabId " & CabId | |
Set record = view.Fetch : CheckError | |
'If Not record Is Nothing Then Wscript.Echo "DiskID: " & record.IntegerData(1) | |
If record Is Nothing Or NewFlag=1 Then ' Media table empty | |
Set record = Installer.CreateRecord(3) | |
record.IntegerData(1) = CabId | |
updateMode = msiViewModifyInsert | |
'Wscript.Echo MediaTableRows(i) & "InsideCreate" & CabId | |
NewFlag = 1 | |
End If | |
record.IntegerData(2) = MediaTableRows(i) | |
record.StringData(3) = CabfileName & CabId & ".cab" | |
view.Modify updateMode, record | |
Next | |
Set sumInfo = database.SummaryInformation(3) : CheckError | |
sumInfo.Property(11) = Now | |
sumInfo.Property(13) = Now | |
sumInfo.Property(15) = (shortNames And 1) + 2 | |
sumInfo.Persist | |
End If | |
' Embed cabinet if requested | |
If embedCab Then | |
Set view = database.OpenView("SELECT `Name`,`Data` FROM _Streams") : CheckError | |
view.Execute : CheckError | |
For i = 0 to ubound(MediaTableRows) | |
CabId = (i+1) | |
CabfileName = baseName & CabId & ".cab" | |
Set record = Installer.CreateRecord(2) | |
record.StringData(1) = CabfileName | |
record.SetStream 2, CabfileName : CheckError | |
view.Modify msiViewModifyAssign, record : CheckError 'replace any existing stream of that name | |
Next | |
End If | |
' Commit database in case updates performed | |
database.Commit : CheckError | |
Wscript.Quit 0 | |
' Extract argument value from command line, processing any option flags | |
Function NextArgument | |
Dim arg | |
Do ' loop to pull in option flags until an argument value is found | |
'Wscript.Echo iArg & " " & arg | |
If iArg >= argCount Then Exit Function | |
arg = Wscript.Arguments(iArg) | |
'Wscript.Echo iArg & " " & arg | |
iArg = iArg + 1 | |
If (AscW(arg) <> AscW("/")) And (AscW(arg) <> AscW("-")) Then Exit Do | |
Select Case UCase(Right(arg, Len(arg)-1)) | |
Case "C" : makeCab = True | |
Case "E" : embedCab = True | |
Case "F" : cabSize = "1.44M" | |
Case "L" : compressType = "LZX" | |
Case "R" : removeCab = True | |
Case "S" : sequenceFile = True | |
Case "U" : updateMsi = True | |
'Case "M" : MaxFilesPerCab = 2000 | |
Case Else: Wscript.Echo "Invalid option flag:", arg : Wscript.Quit 1 | |
End Select | |
Loop | |
NextArgument = arg | |
End Function | |
Sub CheckError | |
Dim message, errRec | |
If Err = 0 Then Exit Sub | |
message = Err.Source & " " & Hex(Err) & ": " & Err.Description | |
If Not installer Is Nothing Then | |
Set errRec = installer.LastErrorRecord | |
If Not errRec Is Nothing Then message = message & vbNewLine & errRec.FormatText | |
End If | |
Fail message | |
End Sub | |
Sub Fail(message) | |
Wscript.Echo message | |
Wscript.Quit 2 | |
End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment