1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
' Windows Installer utility to manage the summary information stream
' For use with Windows Scripting Host, CScript.exe or WScript.exe
' Copyright (c) 1999-2001, Microsoft Corporation
' Demonstrates the use of the database summary information methods
Option Explicit
Const msiOpenDatabaseModeReadOnly = 0
Const msiOpenDatabaseModeTransact = 1
Const msiOpenDatabaseModeCreate = 3
Dim propList(19, 1)
propList( 1,0) = "Codepage" : propList( 1,1) = "ANSI codepage of text strings in summary information only"
propList( 2,0) = "Title" : propList( 2,1) = "Package type, e.g. Installation Database"
propList( 3,0) = "Subject" : propList( 3,1) = "Product full name or description"
propList( 4,0) = "Author" : propList( 4,1) = "Creator, typically vendor name"
propList( 5,0) = "Keywords" : propList( 5,1) = "List of keywords for use by file browsers"
propList( 6,0) = "Comments" : propList( 6,1) = "Description of purpose or use of package"
propList( 7,0) = "Template" : propList( 7,1) = "Target system: Platform(s);Language(s)"
propList( 8,0) = "LastAuthor" : propList( 8,1) = "Used for transforms only: New target: Platform(s);Language(s)"
propList( 9,0) = "Revision" : propList( 9,1) = "Package code GUID, for transforms contains old and new info"
propList(11,0) = "Printed" : propList(11,1) = "Date and time of installation image, same as Created if CD"
propList(12,0) = "Created" : propList(12,1) = "Date and time of package creation"
propList(13,0) = "Saved" : propList(13,1) = "Date and time of last package modification"
propList(14,0) = "Pages" : propList(14,1) = "Minimum Windows Installer version required: Major * 100 + Minor"
propList(15,0) = "Words" : propList(15,1) = "Source flags: 1=short names, 2=compressed, 4=network image"
propList(16,0) = "Characters" : propList(16,1) = "Used for transforms only: validation and error flags"
propList(18,0) = "Application" : propList(18,1) = "Application associated with file, ""Windows Installer"" for MSI"
propList(19,0) = "Security" : propList(19,1) = "0=Read/write 1=Readonly recommended 2=Readonly enforced"
Dim iArg, iProp, property, value, message
Dim argCount:argCount = Wscript.Arguments.Count
If argCount > 0 Then If InStr(1, Wscript.Arguments(0), "?", vbTextCompare) > 0 Then argCount = 0
If (argCount = 0) Then
message = "Windows Installer utility to manage summary information stream" &_
vbNewLine & " 1st argument is the path to the storage file (installer package)" &_
vbNewLine & " If no other arguments are supplied, summary properties will be listed" &_
vbNewLine & " Subsequent arguments are property=value pairs to be updated" &_
vbNewLine & " Either the numeric or the names below may be used for the property" &_
vbNewLine & " Date and time fields use current locale format, or ""Now"" or ""Date""" &_
vbNewLine & " Some properties have specific meaning for installer packages"
For iProp = 1 To UBound(propList)
property = propList(iProp, 0)
If Not IsEmpty(property) Then
message = message & vbNewLine & Right(" " & iProp, 2) & " " & property & " - " & propLIst(iProp, 1)
End If
Next
message = message & vbNewLine & vbNewLine & "Copyright (C) Microsoft Corporation, 1999-2001. All rights reserved."
Wscript.Echo message
Wscript.Quit 1
End If
' Connect to Windows Installer object
On Error Resume Next
Dim installer : Set installer = Nothing
Set installer = Wscript.CreateObject("WindowsInstaller.Installer") : If CheckError("MSI.DLL not registered") Then Wscript.Quit 2
' Evaluate command-line arguments and open summary information
Dim cUpdate:cUpdate = 0 : If argCount > 1 Then cUpdate = 20
Dim sumInfo : Set sumInfo = installer.SummaryInformation(Wscript.Arguments(0), cUpdate) : If CheckError(Empty) Then Wscript.Quit 2
' If only package name supplied, then list all properties in summary information stream
If argCount = 1 Then
' For iProp = 1 to UBound(propList)
iProp = 9
value = sumInfo.Property(iProp) : CheckError(Empty)
' If Not IsEmpty(value) Then message = message & vbNewLine & Right(" " & iProp, 2) & " " & propList(iProp, 0) & " = " & value
If Not IsEmpty(value) Then message = "" & value
' Next
Wscript.Echo message
Wscript.Quit 0
End If
' Process property settings, combining arguments if equal sign has spaces before or after it
For iArg = 1 To argCount - 1
property = property & Wscript.Arguments(iArg)
Dim iEquals:iEquals = InStr(1, property, "=", vbTextCompare) 'Must contain an equals sign followed by a value
If iEquals > 0 And iEquals <> Len(property) Then
value = Right(property, Len(property) - iEquals)
property = Left(property, iEquals - 1)
If IsNumeric(property) Then
iProp = CLng(property)
Else ' Lookup property name if numeric property ID not supplied
For iProp = 1 To UBound(propList)
If propList(iProp, 0) = property Then Exit For
Next
End If
If iProp > UBound(propList) Then Wscript.Echo "Unknown summary property name: " & property : Wscript.Quit 2
If iProp = 11 Or iProp = 12 Or iProp = 13 Then
If UCase(value) = "NOW" Then value = Now
If UCase(value) = "DATE" Then value = Date
value = CDate(value)
End If
If iProp = 1 Or iProp = 14 Or iProp = 15 Or iProp = 16 Or iProp = 19 Then value = CLng(value)
sumInfo.Property(iProp) = value : CheckError("Bad format for property value " & iProp)
property = Empty
End If
Next
If Not IsEmpty(property) Then Wscript.Echo "Arguments must be in the form: property=value " & property : Wscript.Quit 2
' Write new property set. Note! must write even if error, else entire stream will be deleted
sumInfo.Persist : If CheckError("Error persisting summary property stream") Then Wscript.Quit 2
Wscript.Quit 0
Function CheckError(message)
If Err = 0 Then Exit Function
If IsEmpty(message) Then message = Err.Source & " " & Hex(Err) & ": " & Err.Description
If Not installer Is Nothing Then
Dim errRec : Set errRec = installer.LastErrorRecord
If Not errRec Is Nothing Then message = message & vbNewLine & errRec.FormatText
End If
Wscript.Echo message
CheckError = True
Err.Clear
End Function
|
