Skip to content
Permalink
Browse files

Overhaul internal user database system

- Get rid of udtGetAccessResponse and udtDatabase, which were basically
2 implementation of the exact same thing.
- Move user database functionality to a separate class, globally
referenced as "Database"
- Database entries are now stored (in memory) as clsDBEntryObj objects.
- Access inquiries return a udtUserAccess object which does not contain
any of the metadata associated with the entry it's based on, only
access-related information.
- A local, deep copy of the database and its objects can be obtained by
using obj.CreateCopy(). The database manager has been retrofitted to use
this new functionality.
- Got rid of OnAddOld() and OnRemOld(). OnAdd() now parses arguments and
passes the request off to the database class through
Database.HandleAddCommand(). Commands that were previously based on add
(shitadd, tagadd, safeadd + their del counterparts) also use this
interface.
- Removing a group no longer removes all of the members of that group.
They are moved to another one of their parent groups or the root node if
they don't have any. Fixes #39

Unrelated to the database changes but which got lumped in here...
- Several command behavior fixes. Many commands were doing redundant
checks or recreating "console" access on their own. Console access can
be acquired from the database class through Database.GetConsoleAccess().
- Fixed some commands that did not respond when invalid.
- Renamed the internal (console) user to <console> since the former is
now a valid username. Fixes #41
- Fixed tagban command, issue #40
- Fixed some issues with the database manager not showing all entries

Probably fixed and broke a few other things that were minor and I've
forgotten about.
  • Loading branch information...
Davnit committed Mar 13, 2017
1 parent 7896fc4 commit 3142722b598133565ea349b52742f77b26f6e115
@@ -116,6 +116,7 @@ Class=clsKeyDecoder; clsKeyDecoder.cls
Module=modConstants; modConstants.bas
Class=clsConfig; clsConfig.cls
Form=frmAccountManager.frm
Class=clsDatabase; clsDatabase.cls
IconForm="frmChat"
Startup="frmChat"
HelpFile=""
@@ -414,15 +414,15 @@ Public Function CheckUser(Username As String, Optional ByRef CurrentUser As clsU
doCheck = True

If (Self.IsOperator) Then
Dim DBEntry As udtGetAccessResponse
Dim DBEntry As udtUserAccess
Dim i As Integer
Dim Message As String

If (CurrentUser Is Nothing) Then
Set CurrentUser = Users(GetUserIndex(Username))
End If

DBEntry = GetCumulativeAccess(CurrentUser.DisplayName, "USER")
DBEntry = Database.GetUserAccess(CurrentUser.DisplayName)

If (DBEntry.Rank < AutoModSafelistValue) Then
' Not high enough rank to be safe from auto-mod
@@ -587,7 +587,7 @@ Public Function CheckUsers() As Integer

If (Self.IsOperator) Then
Dim CurrentUser As clsUserObj
Dim DBEntry As udtGetAccessResponse
Dim DBEntry As udtUserAccess
Dim i As Integer
Dim Message As String
Dim doCheck As Boolean
@@ -603,7 +603,7 @@ Public Function CheckUsers() As Integer

If (CurrentUser.IsOperator = False) Then
DBEntry = _
GetCumulativeAccess(CurrentUser.DisplayName, "USER")
Database.GetUserAccess(CurrentUser.DisplayName)

If (InStr(1, DBEntry.Flags, "D", vbBinaryCompare) <> 0) Then
If (DBEntry.Rank > HighRank) Then
@@ -225,16 +225,17 @@ On Error GoTo ERROR_HANDLER
Dim Restriction As clsCommandRestrictionObj
Dim sTemp As String
Dim sError As String
Dim dbAccess As udtGetAccessResponse
dbAccess = GetCumulativeAccess(Me.Username)
sArgs = Me.Args

Dim dbAccess As udtUserAccess

If (IsLocal) Then
dbAccess.Rank = 201
dbAccess.Flags = "A"
If IsLocal Then
dbAccess = Database.GetConsoleAccess()
Else
dbAccess = Database.GetUserAccess(Me.Username)
End If

sArgs = Me.Args


If (dbAccess.Rank >= Me.docs.RequiredRank And Me.docs.RequiredRank > -1) Then
m_hasaccess = True
End If
@@ -64,60 +64,56 @@ Public Property Let Flags(ByVal strFlags As String)
m_Flags = strFlags
End Property

Public Function IsInGroup(ByVal GroupName As String) As Boolean
Dim i As Integer
Dim pos As Integer
Public Function IsInGroup(ByVal sGroupName As String) As Boolean
Dim i As Integer
Dim sCurGroup As String

IsInGroup = False

For i = 1 To Groups.Count
pos = InStr(1, Groups(i).Name, Space$(1), vbBinaryCompare)

If (pos > 0) Then
Groups(i).Name = Mid$(Groups(i).Name, 1, pos - 1)
' Internally all of the group objects are strings,
' but when used in scripting they are instances of clsDBEntryObj.
If TypeOf Groups.Item(i) Is clsDBEntryObj Then
sCurGroup = Groups.Item(i).Name
Else
sCurGroup = Split(Groups.Item(i), Space(1))(0)
End If

If (StrComp(GroupName, Groups(i).Name, vbTextCompare) = 0) Then
If (StrComp(sGroupName, sCurGroup, vbTextCompare) = 0) Then
IsInGroup = True

Exit Function
End If
Next i
End Function

Public Function HasFlag(ByVal strFlag As String, Optional ByVal CaseSensitive As Boolean = True) As Boolean
If (CaseSensitive) Then
HasFlag = (InStr(1, m_flags, strFlag, vbBinaryCompare) <> 0)
Else
HasFlag = (InStr(1, m_flags, strFlag, vbTextCompare) <> 0)
End If
Public Function HasFlag(ByVal strFlag As String, Optional ByVal bCaseSensitive As Boolean = True) As Boolean
Dim cmCompare As CompareMethod
cmCompare = IIf(bCaseSensitive, vbBinaryCompare, vbTextCompare)

HasFlag = (InStr(1, m_Flags, strFlag, cmCompare) > 0)
End Function

Public Function HasAnyFlag(ByVal strFlags As String, Optional ByVal CaseSensitive As Boolean = True) As Boolean
Public Function HasAnyFlag(ByVal strFlags As String, Optional ByVal bCaseSensitive As Boolean = True) As Boolean
Dim i As Integer

HasAnyFlag = False

For i = 1 To Len(strFlags)
If (CaseSensitive) Then
HasAnyFlag = (InStr(1, m_flags, Mid$(strFlags, i, 1), vbBinaryCompare) <> 0)
Else
HasAnyFlag = (InStr(1, m_flags, Mid$(strFlags, i, 1), vbTextCompare) <> 0)
End If

If (HasAnyFlag) Then
If HasFlag(Mid(strFlags, i, 1), bCaseSensitive) Then
HasAnyFlag = True
Exit Function
End If
Next i
End Function

Public Function HasFlags(ByVal strFlags As String, Optional ByVal CaseSensitive As Boolean = True) As Boolean
Public Function HasFlags(ByVal strFlags As String, Optional ByVal bCaseSensitive As Boolean = True) As Boolean
Dim i As Integer

HasFlags = True

For i = 1 To Len(strFlags)
If (CaseSensitive) Then
HasFlags = (InStr(1, m_flags, Mid$(strFlags, i, 1), vbBinaryCompare) <> 0)
Else
HasFlags = (InStr(1, m_flags, Mid$(strFlags, i, 1), vbTextCompare) <> 0)
End If

If (HasFlags = False) Then
If Not HasFlag(Mid(strFlags, i, 1), bCaseSensitive) Then
HasFlags = False
Exit Function
End If
Next i
@@ -172,7 +168,7 @@ End Property
Public Property Get MembersOf() As Collection
Set MembersOf = New Collection

If (StrComp(m_type, "Group", vbTextCompare) = 0) Then
If (StrComp(m_Type, DB_TYPE_GROUP, vbTextCompare) = 0) Then
'Do something..
End If
End Property
@@ -188,3 +184,52 @@ End Property
Public Sub AddGroup(ByVal sGroup As String)
m_Groups.Add sGroup, sGroup
End Sub

Public Sub ClearGroups()
Set m_Groups = New Collection
End Sub

' Returns a display string describing the entry.
Public Function ToString() As String
ToString = Me.Name

If Len(Me.EntryType) > 0 Then
If StrComp(Me.EntryType, DB_TYPE_USER, vbTextCompare) <> 0 Then
ToString = ToString & " (" & LCase(Me.EntryType) & ")"
End If
End If
End Function

' Creates a deep copy of the entry.
Public Function CreateCopy() As clsDBEntryObj
Dim i As Integer

Set CreateCopy = New clsDBEntryObj
With CreateCopy
.Name = Me.Name
.Rank = Me.Rank
.Flags = Me.Flags
.EntryType = Me.EntryType
.BanMessage = Me.BanMessage

.CreatedBy = Me.CreatedBy
.CreatedOn = Me.CreatedOn
.ModifiedBy = Me.ModifiedBy
.ModifiedOn = Me.ModifiedOn

If Me.Groups.Count > 0 Then
If TypeOf Me.Groups.Item(1) Is clsDBEntryObj Then
For i = 1 To Me.Groups.Count
.Groups.Add Me.Groups.Item(i).CreateCopy(), Me.Groups.Item(i).Name
Next i
Else
For i = 1 To Me.Groups.Count
.Groups.Add Me.Groups.Item(i), Me.Groups.Item(i)
Next i
End If
End If

.LastSeen = Me.LastSeen
End With
End Function

0 comments on commit 3142722

Please sign in to comment.
You can’t perform that action at this time.