Planet Source Code Jumbo …e CD Visual Basic 1 to 7/1_2002.ISO/Data/Zips/Multi-Leve250338212001.psc/Security2/cSecurity2.cls

Visual Basic class definition | 2001-08-20 | 12.6 KB | 379 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsSecurity"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'/* Author: Morgan Haueisen ([e-mail])
'/* Copyright (c) 2000-2001

'/* This class is the server for the client forms and modules
'/* that maintain user and group security.

'/* cfSecurityGroups.frm
'/* cfSecurityLogin.frm
'/* cfSecurityManage.frm
'/* modSecurity.bas

Option Explicit

'/* Password for Security file (security.pwd)
Const DB_PWD As String = ";PWD=MorganH"


Public Function ListAllGroups(ObjBox As Object, ByVal SecurityDatabasePath As String, Optional ByVal GroupName As String = "") As Variant
'/* This function lists all groups defined with the current
'/* security file and places values into an ListBox or ComboBox.

'/* ObjBox - ListBox or ComboBox the info will be put in.
'/* SecurityDatabasePath - The path and file name of the security database file.
'/* Returns:    True/False if ok.

  Dim MyDB  As Database
  Dim MySet As Recordset
  Dim SetIndex As Boolean, i As Integer

    On Error GoTo Error_Function
    Set MyDB = Workspaces(0).OpenDatabase(SecurityDatabasePath, False, False, DB_PWD)

    ObjBox.Clear

    Set MySet = MyDB.OpenRecordset("Select * From Groups;")
    If Not (MySet.EOF And MySet.BOF) Then
        Do
            ObjBox.AddItem MySet!GroupName
            If MySet!GroupName = GroupName Then SetIndex = True
            MySet.MoveNext
        Loop Until MySet.EOF
    End If

    MySet.Close
    MyDB.Close
    Set MySet = Nothing
    Set MyDB = Nothing

    If SetIndex Then
        For i = 0 To ObjBox.ListCount - 1
            If ObjBox.List(i) = GroupName Then
                ObjBox.ListIndex = i
                Exit For
            End If
        Next i
    End If

    ListAllGroups = True

Exit_Function:
    On Local Error Resume Next
Exit Function


Error_Function:
    Err.Raise Err.Number, "clsSecurity::ListAllGroups", Err.Description
    ListAllGroups = False
    Resume Exit_Function

End Function

Public Function ListAllGroupsPerUser(ObjBoxNotIn As Object, ObjBoxIn As Object, ByVal UserName As String, ByVal SecurityDatabasePath As String) As Boolean
'/* This function will fill a listbox of all of the groups that a User
'/* is not part of and a second listbox that contains the Groups
'/* that the User is a member of.

'/* ObjBoxNotIn - Listbox or ComoBox that contains groups the user is not a member of.
'/* ObjBoxIn - Listbox or ComoBox that contains groups the user is a member of.
'/* UserName - a string that holds the name of the user.
'/* SecurityDatabasePath - The path and file name of the security database file.
'/* Returns:    True/False if ok.

  Dim MyDB  As Database
  Dim MyGroups As Recordset
  Dim MyRights As Recordset

    Set MyDB = Workspaces(0).OpenDatabase(SecurityDatabasePath, False, False, DB_PWD)

    ObjBoxIn.Clear
    ObjBoxNotIn.Clear

    Set MyRights = MyDB.OpenRecordset("Select * From UserRights Where UserRights.UserName='" & UserName & "';")
    Set MyGroups = MyDB.OpenRecordset("Select * From Groups;")

    If MyGroups.EOF And MyGroups.BOF Then
    Else
        Do
            MyRights.FindFirst "[GroupName]='" & MyGroups!GroupName & "'"
            If MyRights.NoMatch Then
                ObjBoxNotIn.AddItem MyGroups!GroupName
            Else
                ObjBoxIn.AddItem MyGroups!GroupName
            End If
            MyGroups.MoveNext
        Loop Until MyGroups.EOF
    End If

    MyGroups.Close
    MyRights.Close
    MyDB.Close
    Set MyGroups = Nothing
    Set MyRights = Nothing
    Set MyDB = Nothing

End Function

Public Function CreateUser(ByVal UserName As String, ByVal NoExp As Integer, _
                            ByVal SecurityDatabasePath As String, _
                            ByVal SystemID As String) As Boolean
'/* This function creates a user
'/* UserName - A string that holds the name of the user.
'/* Password - A string that holds the user's password.
'/* SystemID - A string that holds the applications ID. This prevents the
'/*            security file from being copied from one app to another to gain access
'/* SecurityDatabasePath - The path and file name of the security database file.
'/* Returns:    True/False if ok.

  Dim MyDB  As Database
  Dim MySet As Recordset

    On Error GoTo Error_Function

    Set MyDB = Workspaces(0).OpenDatabase(SecurityDatabasePath, False, False, DB_PWD)

    Set MySet = MyDB.OpenRecordset("Select * From Users Where [UserName] = '" & UserName & "'")
    If MySet.EOF And MySet.BOF Then
        MySet.AddNew
        MySet!UserName = UserName
        MySet!SystemID = SystemID
        MySet!Date = Date
        MySet!NoExp = CBool(NoExp)
        MySet!UserPassword = "password"
        MsgBox "The default password has been set to the word 'password'.", vbInformation
        MySet.Update
        CreateUser = True
    Else
        CreateUser = False
    End If

    MySet.Close
    MyDB.Close
    Set MySet = Nothing
    Set MyDB = Nothing


Exit_Function:
    On Error Resume Next
Exit Function

Error_Function:
    Err.Raise Err.Number, "clsSecurity::CreateUser", Err.Description
    CreateUser = False
    Resume Exit_Function

End Function
Public Function EditUser(ByVal UserOldName As String, ByVal UserNewName As String, ByVal NoExp As Integer, _
                            ByVal SecurityDatabasePath As String, _
                            ByVal SystemID As String) As Boolean
'/* This function creates a user
'/* UserOldName - A string that holds the name of the selected user.
'/* UserNewName - A string that holds the new name of the selected user.
'/* NoExp    - A integer that determins if a user's password expires.
'/* SystemID - A string that holds the applications ID. This prevents the
'/*            security file from being copied from one app to another to gain access
'/* SecurityDatabasePath - The path and file name of the security database file.
'/* Returns:    True/False if ok.

  Dim MyDB  As Database
  Dim MySet As Recordset

    On Error GoTo Error_Function

    Set MyDB = Workspaces(0).OpenDatabase(SecurityDatabasePath, False, False, DB_PWD)
    If UserNewName = vbNullString Then UserNewName = UserOldName

    Set MySet = MyDB.OpenRecordset("Select * From Users Where [UserName] = '" & UserOldName & "'")
    If Not (MySet.EOF And MySet.BOF) Then
        MySet.Edit
        MySet!UserName = UserNewName
        MySet!NoExp = CBool(NoExp)
        MySet.Update
        EditUser = True
    Else
        EditUser = False
    End If

    MySet.Close

    If UserOldName <> UserNewName Then
        MyDB.Execute "UPDATE UserRights SET UserRights.UserName = '" & UserNewName & "' WHERE (((UserRights.UserName)='" & UserOldName & "'));"
    End If

    MyDB.Close
    Set MySet = Nothing
    Set MyDB = Nothing


Exit_Function:
    On Error Resume Next
Exit Function

Error_Function:
    Err.Raise Err.Number, "clsSecurity::EditUser", Err.Description
    EditUser = False
    Resume Exit_Function

End Function

Public Function CreateGroup(ByVal NewGroupName As String, ByVal SecurityDatabasePath As String, Optional ByVal GroupName As String = "") As Boolean
'/* This function creates a user
'/* GroupName - A string that holds the name of the user.
'/* SecurityDatabasePath - The path and file name of the security database file.
'/* Returns:    True/False if ok.

  Dim MyDB  As Database
  Dim MySet As Recordset

    On Error GoTo Error_Function

    Set MyDB = Workspaces(0).OpenDatabase(SecurityDatabasePath, False, False, DB_PWD)

    If GroupName > vbNullString Then '/* Edit Group Name
        Set MySet = MyDB.OpenRecordset("Select Groups.* From Groups Where [GroupName] = '" & NewGroupName & "'")
        If MySet.EOF And MySet.BOF Then
            MySet.Close
            Set MySet = MyDB.OpenRecordset("Select Groups.* From Groups Where [GroupName] = '" & GroupName & "'")
            If Not (MySet.EOF And MySet.BOF) Then
                MySet.Edit
                MySet!GroupName = NewGroupName
                MySet.Update
                CreateGroup = True
            End If

            MySet.Close
            MyDB.Execute "UPDATE UserRights SET UserRights.GroupName ='" & NewGroupName & _
                            "' WHERE UserRights.GroupName='" & GroupName & "';"

        Else
            MySet.Close
            CreateGroup = False
        End If
    Else '/* Add a Group Name
        Set MySet = MyDB.OpenRecordset("Select Groups.* From Groups Where [GroupName] = '" & NewGroupName & "'")
        If MySet.EOF And MySet.BOF Then
            MySet.AddNew
            MySet!GroupName = NewGroupName
            MySet.Update
            CreateGroup = True
        Else
            CreateGroup = False
        End If
        MySet.Close
    End If

    MyDB.Close
    Set MySet = Nothing
    Set MyDB = Nothing


Exit_Function:
    On Error Resume Next
Exit Function

Error_Function:
    Err.Raise Err.Number, "clsSecurity::CreateUser", Err.Description
    CreateGroup = False
Resume Exit_Function

End Function


Public Function AddUserToGroup(ByVal GroupName As String, ByVal UserName As String, ByVal SecurityDatabasePath As String) As Boolean
'/* This function adds a user to a group.
'/* UserName - A string that holds the name of the user.
'/* GroupName - A string that holds the group name.
'/* SecurityDatabasePath - The path and file name of the security database file.
'/* Returns:    True/False if ok.

  Dim MyDB  As Database
  Dim MySet As Recordset

    On Error GoTo Error_Function
    Set MyDB = Workspaces(0).OpenDatabase(SecurityDatabasePath, False, False, DB_PWD)

    Set MySet = MyDB.OpenRecordset("Select * From UserRights Where [GroupName] = '" & GroupName & "'")
    MySet.FindFirst "[UserName] = '" & UserName & "'"
    If MySet.NoMatch Then
        MySet.AddNew
        MySet!UserName = UserName
        MySet!GroupName = GroupName
        MySet.Update
        AddUserToGroup = True
    End If
    MySet.Close
    MyDB.Close
    Set MySet = Nothing
    Set MyDB = Nothing

Exit_Function:
    On Error Resume Next
Exit Function


Error_Function:
    Err.Raise Err.Number, "clsSecurity::AddUserToGroup", Err.Description
    Resume Exit_Function
End Function

Public Function Login(ByVal UserName As String, ByVal Password As String, _
                        ByVal SecurityDatabasePath As String, _
                        ByVal SystemID As String) As Integer
'/* This function will login to the database and the security file.
'/* UserName - A string that holds the name of the user.
'/* Password - A string that holds the user's password.
'/* SystemID - A string that holds the applications ID. This prevents the
'/*            security file from being copied from one app to another to gain access.
'/* SecurityDatabasePath - The path and file name of the security database file.
'/* Returns:    True or False

  Dim MyDB     As Database
  Dim MySet    As Recordset
  Dim ExpDays  As Byte
  Dim PassDiff As Integer
  Dim NoExp    As Boolean

    On Error GoTo Error_Function

    Set MyDB = Workspaces(0).OpenDatabase(SecurityDatabasePath, False, False, DB_PWD)

    Set MySet = MyDB.OpenRecordset("Select ExpDays.Days from ExpDays")
    ExpDays = MySet!Days
    MySet.Close

    Set MySet = MyDB.OpenRecordset("Select Users.* From Users Where [UserName] = '" & UserName & _
                                    "' AND [SystemID]='" & SystemID & "';")


    If MySet.EOF And MySet.BOF Then
        '/* No user ID found
        Login = 0
    Else
        '/* if the user's password is password then ignore any password the user has typed.
        If MySet!UserPassword = "password" Then Password = "password"
        If MySet!UserPassword <> Password Then
            Login = 0
        Else
            '/* The login was su    MSet.E uhe logintVlu= 0
        Else
            '/* The login was su    MSet.E uhe alse
  >pbasePath, False, False, DB_PWD)

    Set MySet = MyDB.OpenRecordset("Select-(_.* FrFalin = 0
   yo>Namtiet = MyDB.OpenRecordseeateUser", Err.Description
    CreateyDByDByDBg
    Cre  Login = 0
        C;e fiSet