Attribute VB_Name = "basScriptJetSecurity"
'------------------------------------------
'   (c) 1999 Trigeminal Software, Inc.  All Rights Reserved
'------------------------------------------
Option Compare Text
Option Explicit

Function ScriptSecurityInfo(Optional stDatabaseName As String) As String
    Dim wrk As DAO.Workspace
    Dim db As DAO.Database
    Dim usr As DAO.User
    Dim grp As DAO.Group
    Dim doc As DAO.Document
    Dim cnt As DAO.Container
    Dim stCode As String
    
    Set wrk = DBEngine.Workspaces(0)
    
    If Len(stDatabaseName) = 0 Then
        Set db = wrk.Databases(0)
    Else
        Set db = wrk.OpenDatabase(stDatabaseName)
    End If
    
    stCode = stCode & "DBEngine.OpenDatabase(""" & db.Name & """)" & vbCrLf & vbCrLf
    
    For Each cnt In db.Containers
        
        Select Case cnt.Name
            Case "Tables", "Forms", "Reports", "Scripts", "Modules"
            
                ' Don't bother setting the container if it has no documents in it
                If cnt.Documents.Count > 0 Then
                    stCode = stCode & "Set cnt = db.Containers(""" & cnt.Name & """)" & vbCrLf
                
                    For Each doc In cnt.Documents
                        Select Case doc.Name
                        
                            Case "MSysRelationships", "MSysQueries", "MSysObjects", "MSysACEs", "MSysAccessObjects"
                                ' Do not bother with these tables since you cannot set perms on them
                                ' anyway without causing other problems
                                
                            Case Else
                        
                                stCode = stCode & "Set doc = cnt.Documents(""" & doc.Name & """)" & vbCrLf
                                ' Create the tables with info
                                For Each grp In wrk.Groups
                                    doc.UserName = grp.Name
                                    stCode = stCode & "doc.UserName = """ & grp.Name & """" & ": "
                                    stCode = stCode & "doc.Permissions = " & doc.Permissions & vbCrLf
                                Next grp
                                
                                For Each usr In wrk.Users
                                    Select Case usr.Name
                                        Case "Engine", "Creator"
                                            ' do nothing for these internal users
                                        Case Else
                                            doc.UserName = usr.Name
                                            stCode = stCode & "doc.UserName = """ & usr.Name & """" & ": "
                                            stCode = stCode & "doc.Permissions = " & doc.Permissions & vbCrLf
                                    End Select
                                Next usr
                                
                                stCode = stCode & vbCrLf
                        End Select
                    Next doc
                    Set doc = Nothing
                End If
                
            Case Else
                ' Do nothing for other containers
        End Select
    Next cnt
    
    Set cnt = Nothing
    If Len(stDatabaseName) > 0 Then db.Close
    Set db = Nothing
    Set wrk = Nothing
    
    ScriptSecurityInfo = stCode
End Function