Visual Basic

Quote:

Hi everyone!

I'm making an application which requires users with different permissions/previleges to login and use the application.For example, if the user is "admin", all menu items in the menu bar are shown and enabled. If the user is say "user_group1", some of the menu items are to be hidden. The same for "user_group2", "user_group3", "user_group4" and so on.

I could put a code for each specific user in each form but that's a great deal since users and their user groups may be added after application deployment. So it has to be something flexible.

I want the user "Administrator" to be able to assign/change permissions to others users of the system.

How do I do this?
I have been thinking of creating a table that will include user_groups and permisions, say like a row: user_group (user_group1, user_group2,user_group3) and permission (File,Edit,Backup,Manage Users (these being menu items)) and then for each user I will be setting either "Yes" or "No" under each permission/menu item indicating that the menu item is to be hidden of shown.
But, I can read these permission to a dataset but I can't see how to link them with the menu items.

How should I accomplish this please?

What I have done so far:

I had to come up with 5 tables just for this, as a result, I can run an SQL query that will bring a user and the menu items which he/she is supposed to see. I have attached an image showing the results of such a query. Now I need to take what is in the table and effect it by enabling only the shown menu items ('permissionName' in my table). How can I? Since I have them in a dataset, is it possible to do some loop to accomplish that?

Sorry, it seems I can't upload an img in codeproject.com

Private Function IBAAGMQConnect() As String

    Dim CompCode As Long      ' Completion code
    Dim Reason As Long        ' Reason code
    Dim od As MQOD            ' Object descriptor

    Dim CnoCD As MQCNOCD                                ' Connect Options for SSL
    Dim QMgrName As String * MQ_Q_MGR_NAME_LENGTH       ' Pass to MQCONN

    ' Connect to the Queue Manager
    QMgrName = QManagerName




    MQCONN QMgrName, gHcon, CompCode, Reason

    If CompCode <> MQCC_OK Then
        IBAAGMQConnect = "IBAAG MQ: Connection to Queue Manager failed. Reason: " & Reason & " Mgr Name is " & QMgrName
        Exit Function
    Else
        IBAAGMQConnect = "0000"
    End If

End Function

Private Function IBAAGMQOpen(FQueueName As String) As String

    Dim CompCode As Long      ' Completion code
    Dim Reason As Long        ' Reason code
    Dim O_options As Long     ' Open options
    Dim od As MQOD            ' Object descriptor

    ' Open the queue specified in the Queue textbox
    ' if the connect was successful
    If gHcon Then

        MQOD_DEFAULTS od
        od.ObjectName = FQueueName

        ' To specify a queue manager uncomment the
        ' Following line which is (Case-Sensitive)
        od.ObjectQMgrName = QManagerName

        od.AlternateUserId = AlternateUsedId


        O_options = MQOO_OUTPUT + MQOO_INPUT_SHARED + MQOO_ALTERNATE_USER_AUTHORITY

        MQOPEN gHcon, od, O_options, gHobj, CompCode, Reason

        If CompCode <> MQCC_OK Then
            Select Case Reason
                Case Is = 2085
                    IBAAGMQOpen = "IBAAG MQ: Opening of " & Trim(FQueueName) & " failed. " & "ReasonCode = (2085) - MQRC_UNKNOWN_OBJECT_NAME: Check the spelling of the Queue name, which is Case-Sensitive."
                Case Is = 2087
                    IBAAGMQOpen = "IBAAG MQ: Opening of " & Trim(FQueueName) & " failed. " & "ReasonCode = (2087) - MQRC_REMOTE_Q_MGR: Check the spelling of the Queue name, which is Case-Sensitive."
            End Select
            Exit Function
        Else
            IBAAGMQOpen = "0000"
        End If
    Else
        IBAAGMQOpen = "IBAAG MQ: Opening of " & Trim(FQueueName) & " failed. " & Reason
    End If

End Function

Dim nUserID As Long
 Dim sToday  As String
 Dim sUser   As String
 Dim sSQL    As String

 Dim li      As ListItem

 Me.lvMain.ListItems.Clear

 'rsUser.MoveFirst

 Set dbGlob = OpenDatabase(GenPath & "WORORDGB.MDB")
 'Set rsCal = Nothing
 sToday = sDate
 Select Case UCase(sType)

     Case "ALL"            'All

         sSQL = "SELECT * FROM [Accum] WHERE [Type] = 'LABOR' AND [Closed]= 0 AND [WOCounter] <> 0 ORDER BY [Date],[UserID],[Start],[WOCounter]"
         Set rsCal = dbGlob.OpenRecordset(sSQL)
         rsCal.MoveLast
         rsCal.MoveFirst

     Case "WO"      'WO

         Set rsCal = dbGlob.OpenRecordset("SELECT * FROM [Accum] WHERE [Type] = 'LABOR' AND [Closed]= 0 AND [WOCounter] = " & CInt(Trim(Me.cmbWOID.Text)) & " ORDER BY [Date],[UserID],[Start],[WOCounter]")
         rsCal.MoveLast
         rsCal.MoveFirst

     Case "WR"          'WORKER

         Set rsCal = dbGlob.OpenRecordset("SELECT * FROM [Accum] WHERE [Type] = 'LABOR' AND [Closed]= 0 AND [WOCounter] <> 0 AND [UserID]=" & CLng(Me.cmbuserID.Text) & " ORDER BY [Date],[UserID],[Start],[WOCounter]")
         rsCal.MoveLast
         rsCal.MoveFirst

     Case "WRWO"         'Worker - WO

         Set rsCal = dbGlob.OpenRecordset("SELECT * FROM [Accum] WHERE [Type] = 'LABOR' AND [Closed]= 0 AND [WOCounter] = " & CInt(Trim(Me.cmbWOID.Text)) & " AND [UserID]=" & CLng(Me.cmbuserID.Text) & " ORDER BY [Date],[UserID],[Start],[WOCounter]")
         rsCal.MoveLast
         rsCal.MoveFirst

 End Select

 With Me.lvMain
     '.ListItems.Clear
     If rsCal.RecordCount = 0 Then
         Set li = .ListItems.Add(1, "ID" & rsUser.Fields("ID").Value, "Empty", , 4)
         Exit Sub
     End If

     For X = 1 To rsCal.RecordCount

         If IsNull(rsCal.Fields("UserID").Value) Then
             sUser = rsCal.Fields("Desc").Value
         Else
             For Y = 0 To cmbUser.ListCount - 1
                 If CLng(rsCal.Fields("UserID").Value) = CLng(cmbuserID.List(Y)) Then
                     sUser = cmbUser.List(Y)
                     Exit For
                 End If
             Next Y
         End If

         Set li = .ListItems.Add(X, "ID" & rsCal.Fields("Counter").Value, sUser, , 2)
         li.SubItems(1) = Format(rsCal.Fields("Date").Value, "mm/dd/yyyy")
         li.SubItems(2) = Format(rsCal.Fields("Start").Value, "hh:mm ampm")
         li.SubItems(3) = Format(rsCal.Fields("End").Value, "hh:mm ampm")
         li.SubItems(4) = Val(rsCal.Fields("Quantity").Value)
         li.SubItems(5) = rsCal.Fields("WOCounter").Value

         rsCal.MoveNext

     Next X
 End With

'Create the connection string
sConnString = "Provider=SQLOLEDB.1;Data Source=SRV002982;" & _
              "Initial Catalog=HFMDSmartFDM_QMR211;" & _
              "Password=password;Persist Security Info=True;User ID=User"

'Create the Connection and Recordset objects
Set conn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

'Open the connection and execute
conn.Open sConnString
Set rs = conn.Execute(CommandString)

    'Check data
    If Not rs.EOF Then
        nRow = nRow + 1
        'Transfer result to WS
        Do While Not rs.EOF
            For Each elem In rs.Fields
                nCol = nCol + 1
                ws.Cells(nRow, nCol) = elem
            Next
        rs.movenext
        Loop
    End If