Figure 3 Setting Attributes

' Create a new library application.
Const AppID = "{DEADBEEF-BADD-BADD-BADD-2BE2DEF4BEDD}"
Const AppName = "MyApplication"
Const AppDesc = "My application's clever description"
Dim cat As COMAdminCatalog
Set cat = New COMAdminCatalog
Dim apps As COMAdminCatalogCollection
Set apps = cat.GetCollection("Applications")
Dim app As COMAdminCatalogObject
Set app = apps.Add
app.Value("ID") = AppID
app.Value("Name") = AppName
app.Value("Description") = AppDesc
app.Value("Activation") = COMAdminActivationInproc
apps.SaveChanges
Figure 4 Find Application by Name
Function ApplicationExists(ByVal AppName As String) As Boolean
  Dim cat As COMAdminCatalog
  Set cat = New COMAdminCatalog
  Dim apps As COMAdminCatalogCollection
  Set apps = cat.GetCollection("Applications")
  apps.Populate
  ' Enumerate through applications looking for AppName.
  Dim app As COMAdminCatalogObject
  For Each app In apps
    If app.Name = AppName Then
      ApplicationExists = True
      Exit Function
    End If
  Next app
  ApplicationExists = False
End Function
Figure 5 Modifying Application Properties
Sub EnableApplicationChanges(AppName As String, Enable As Boolean)
  Dim cat As COMAdminCatalog
  Set cat = New COMAdminCatalog
  Dim apps As COMAdminCatalogCollection
  Set apps = cat.GetCollection("Applications")
  apps.Populate
  ' Enumerate through applications looking for AppName.
  Dim app As COMAdminCatalogObject
  For Each app In apps
    If app.Name = AppName Then
      app.Value("Changeable") = Enable
      app.Value("Deleteable") = Enable
      apps.SaveChanges
      Exit Sub
    End If
  Next app
  ' Raise error if application cannot be found.
  Err.Raise vbObjectError + 1024, , AppName & " not found"
End Sub
Figure 6 Changing Attributes
Const AppID = "{DEADBEEF-BADD-BADD-BADD-2BE2DEF4BEDD}"
Const CLSID = "{B8C16582-C03A-4DCA-912E-90927D6BBDA5}"

Dim cat As COMAdminCatalog
Set cat = New COMAdminCatalog

Dim apps As COMAdminCatalogCollection
Set apps = cat.GetCollection("Applications")
apps.Populate
  
Dim comps As COMAdminCatalogCollection
Dim comp As COMAdminCatalogObject
Dim ComponentFound As Boolean

Set comps = apps.GetCollection("Components", AppID)
comps.Populate
For Each comp In comps
  If comp.Key = CLSID Then
    ComponentFound = True
    Exit For
  End If
Next comp

If ComponentFound Then
  comp.Value("Description") = "This is my cutting-edge description"
  comp.Value("ConstructionEnabled") = True
  comp.Value("ConstructorString") = "Provider=SQLOLEDB;BlahBlahBlah"
  comp.Value("Synchronization") = COMAdminSynchronizationRequired
  comp.Value("Transaction") = COMAdminTransactionNone
  comp.Value("JustInTimeActivation") = False
  comp.Value("COMTIIntrinsics") = False
  comp.Value("IISIntrinsics") = False
  comps.SaveChanges
Else
  Err.Raise vbObjectError + 1025, , "CLSID: " & CLSID & " not found"
End If
Figure 7 Adding Roles
Const AppID = "{DEADBEEF-BADD-BADD-BADD-2BE2DEF4BEDD}"
Const CLSID = "{B8C16582-C03A-4DCA-912E-90927D6BBDA5}"
Const RoleName = "MyRole"
Const AccountName = "Domain Users"
' Add a role to the application.
Dim cat As COMAdminCatalog
Set cat = New COMAdminCatalog
Dim apps As COMAdminCatalogCollection
Set apps = cat.GetCollection("Applications")
apps.Populate
Dim roles As COMAdminCatalogCollection
Set roles = apps.GetCollection("Roles", AppID)
Dim role As COMAdminCatalogObject
Set role = roles.Add
role.Value("Name") = RoleName
roles.SaveChanges
' Assign a user account to the role
Dim users As COMAdminCatalogCollection
Set users = roles.GetCollection("UsersInRole", role.Key)
Dim user As COMAdminCatalogObject
Set user = users.Add
user.Value("User") = AccountName
users.SaveChanges
' Reconfigure component to grant access to users in role.
Dim comps As COMAdminCatalogCollection
Dim comp As COMAdminCatalogObject
Dim ComponentFound As Boolean
Set comps = apps.GetCollection("Components", AppID)
comps.Populate
For Each comp In comps
  If comp.Key = CLSID Then
    ComponentFound = True
    Exit For
  End If
Next comp
If ComponentFound Then
  Dim RolesForComponent As COMAdminCatalogCollection
  Set RolesForComponent = comps.GetCollection("RolesForComponent", _
                                               CLSID)
  Dim RoleForComponent As COMAdminCatalogObject
  Set RoleForComponent = RolesForComponent.Add
  RoleForComponent.Value("Name") = role.Name
  RolesForComponent.SaveChanges
Else
  Err.Raise vbObjectError + 1025, , "CLSID " & CLSID & " not found"
End If
Show: