windows-server-2003/admin/pchealth/authtools/prodtools/authdatabase/synonymsets.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "SynonymSets"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"No"
Option Explicit

Public Sub GetAllSynonymSetsRs( _
    ByVal o_rs As ADODB.Recordset _
)
    Dim strQuery As String
    
    CheckDatabaseVersion
    
    CloseRecordSet o_rs
    
    strQuery = "" & _
        "SELECT * " & _
        "FROM SynonymSets " & _
        "ORDER BY Name;"
        
    o_rs.Open strQuery, g_cnn, adOpenStatic, adLockReadOnly

End Sub

Public Sub GetSynonymSetsForKeyword( _
    ByVal i_intKID As Long, _
    ByVal o_rs As ADODB.Recordset _
)

    Dim strQuery As String
    
    CheckDatabaseVersion
    
    CloseRecordSet o_rs
     
    strQuery = "" & _
        "SELECT SynonymSets.* " & _
        "FROM " & _
        "   Synonyms INNER JOIN SynonymSets " & _
        "   ON Synonyms.EID = SynonymSets.EID " & _
        "WHERE (Synonyms.KID = " & i_intKID & ") " & _
        "ORDER BY SynonymSets.Name;"
       
    o_rs.Open strQuery, g_cnn, adOpenStatic, adLockReadOnly

End Sub

Public Sub GetSynonymsRs( _
    ByVal o_rs As ADODB.Recordset _
)

    Dim strQuery As String
    
    CheckDatabaseVersion
    
    CloseRecordSet o_rs
    
    strQuery = "" & _
        "SELECT Synonyms.EID, SynonymSets.Name, Keywords.Keyword " & _
        "FROM " & _
        "   (Keywords INNER JOIN Synonyms " & _
        "   ON Keywords.KID = Synonyms.KID) " & _
        "   INNER JOIN SynonymSets ON SynonymSets.EID = Synonyms.EID " & _
        "ORDER BY Synonyms.EID"
    
    o_rs.Open strQuery, g_cnn, adOpenStatic, adLockReadOnly

End Sub

' Consider only i_arrKeywords(1..UBound).

Public Sub Create( _
    ByVal i_strName As String, _
    ByRef i_vntKeywordsArray As Variant _
)

    Dim rsLock1 As ADODB.Recordset
    Dim rsLock2 As ADODB.Recordset
    Dim rs As ADODB.Recordset
    Dim strQuery As String
    
    CheckDatabaseVersion
    LockTable LOCK_TABLE_SYNONYM_SETS, rsLock1
    LockTable LOCK_TABLE_SYNONYMS, rsLock1
    CheckAuthoringGroupAccess
    
    ' Do some validation to see if the Synonym Set is acceptable.
    
    p_ValidateSynonymSet i_strName
    
    ' Does an active Synonym Set exist with this name?
    
    Set rs = New ADODB.Recordset
    
    p_GetSynonymSet i_strName, rs
    
    If (Not rs.EOF) Then
        Err.Raise errAlreadyExists
        Exit Sub
    End If
    
    rs.Close
    
    ' Create a new record in the database
    
    strQuery = "" & _
        "SELECT * " & _
        "FROM SynonymSets "
        
    rs.Open strQuery, g_cnn, adOpenStatic, adLockPessimistic
    
    If (rs.RecordCount > 0) Then
        rs.MoveLast
    End If
    
    rs.AddNew
    rs("Name") = i_strName
    rs("EID") = p_GetNextEID
    rs.Update
    
    p_AddKeywordsToSynonymSet rs("EID").Value, GetLongArray(i_vntKeywordsArray)

End Sub

Public Sub Delete( _
    ByVal i_intEID As Long _
)

    Dim rsLock1 As ADODB.Recordset
    Dim rsLock2 As ADODB.Recordset
    Dim rs As ADODB.Recordset
    Dim strQuery As String
    Dim strName As String
    
    CheckDatabaseVersion
    LockTable LOCK_TABLE_SYNONYM_SETS, rsLock1
    LockTable LOCK_TABLE_SYNONYMS, rsLock1
    
    Set rs = New ADODB.Recordset
    
    strQuery = "" & _
        "DELETE * " & _
        "FROM SynonymSets " & _
        "WHERE (EID = " & i_intEID & ")"
        
    rs.Open strQuery, g_cnn, adOpenStatic, adLockPessimistic
    
    strQuery = "" & _
        "DELETE * " & _
        "FROM Synonyms " & _
        "WHERE (EID = " & i_intEID & ")"
        
    rs.Open strQuery, g_cnn, adOpenStatic, adLockPessimistic

End Sub

' Consider only i_arrKeywords(1..UBound).

Public Sub Update( _
    ByVal i_intEID As Long, _
    ByVal i_strName As String, _
    ByRef i_vntKeywordsArray As Variant _
)

    Dim rsLock1 As ADODB.Recordset
    Dim rsLock2 As ADODB.Recordset
    Dim arrKeywordsToAdd() As Long
    Dim arrKeywordsToRemove() As Long
    
    CheckDatabaseVersion
    LockTable LOCK_TABLE_SYNONYM_SETS, rsLock1
    LockTable LOCK_TABLE_SYNONYMS, rsLock1

    p_GetKeywordsToAddAndRemove i_intEID, GetLongArray(i_vntKeywordsArray), _
        arrKeywordsToAdd, arrKeywordsToRemove

    p_Rename i_intEID, i_strName, False
    p_AddKeywordsToSynonymSet i_intEID, arrKeywordsToAdd
    p_RemoveKeywordsFromSynonymSet i_intEID, arrKeywordsToRemove

End Sub

Public Sub Rename( _
    ByVal i_intEID As Long, _
    ByVal i_strName As String _
)

    p_Rename i_intEID, i_strName, True

End Sub

Private Sub p_Rename( _
    ByVal i_intEID As Long, _
    ByVal i_strName As String, _
    ByVal i_blnLock As Boolean _
)
    
    Dim rsLock As ADODB.Recordset
    Dim rs As ADODB.Recordset
    Dim strQuery As String
    
    CheckDatabaseVersion
    If (i_blnLock) Then
        LockTable LOCK_TABLE_SYNONYM_SETS, rsLock
    End If
    
    ' Do some validation to see if the Synonym Set is acceptable.
    
    p_ValidateSynonymSet i_strName
    
    ' Does an active Synonym Set exist with this name?
    
    Set rs = New ADODB.Recordset
    
    p_GetSynonymSet i_strName, rs
    
    If (Not rs.EOF) Then
        If ((rs.RecordCount = 1) And (rs("EID") = i_intEID)) Then
            ' The name needn't change
        Else
            Err.Raise errAlreadyExists
        End If
        Exit Sub
    End If
    
    rs.Close
    
    Set rs = New ADODB.Recordset
    
    strQuery = "" & _
        "SELECT * " & _
        "FROM SynonymSets " & _
        "WHERE (EID = " & i_intEID & ")"
        
    rs.Open strQuery, g_cnn, adOpenStatic, adLockPessimistic
    
    ' Does an active Synonym Set exist?
    
    If (rs.EOF) Then
        Exit Sub
    End If
    
    rs("Name") = i_strName
    rs.Update

End Sub

Private Function p_GetNextEID() As Long

    Dim rs As ADODB.Recordset
    Dim strQuery As String
    
    Set rs = New ADODB.Recordset
    
    strQuery = "" & _
        "SELECT Max(EID) as MaxEID " & _
        "FROM SynonymSets "
        
    rs.Open strQuery, g_cnn, adOpenStatic, adLockReadOnly
    
    If (rs.EOF) Then
        p_GetNextEID = 1
    Else
        p_GetNextEID = rs("MaxEID") + 1
    End If

End Function

Private Sub p_GetSynonymSet( _
    ByVal i_strName As String, _
    ByVal o_rs As ADODB.Recordset _
)

    Dim strQuery As String
    
    CloseRecordSet o_rs
    
    strQuery = "" & _
        "SELECT * " & _
        "FROM SynonymSets " & _
        "WHERE (Name = """ & i_strName & """)"
        
    o_rs.Open strQuery, g_cnn, adOpenStatic, adLockReadOnly

End Sub

' Consider only i_arrKeywords(1..UBound).

' Don't try to lock the Synonyms table. This function is only called from
' Create and Update. Those functions have already locked the table.

Private Sub p_AddKeywordsToSynonymSet( _
    ByVal i_intEID As Long, _
    ByRef i_arrKeywords() As Long _
)

    Dim rs As ADODB.Recordset
    Dim strQuery As String
    Dim intIndex As Long
    
    If (UBound(i_arrKeywords) = 0) Then
        Exit Sub
    End If
    
    Set rs = New ADODB.Recordset
    
    strQuery = "" & _
        "SELECT * " & _
        "FROM Synonyms"
        
    rs.Open strQuery, g_cnn, adOpenForwardOnly, adLockPessimistic
    
    For intIndex = 1 To UBound(i_arrKeywords)
        rs.AddNew
        rs("EID") = i_intEID
        rs("KID") = i_arrKeywords(intIndex)
    Next
        
    rs.Update

End Sub

' Consider only i_arrKeywords(1..UBound).

' Don't try to lock the Synonyms table. This function is only called from
' Update. Update has already locked the table.

Private Sub p_RemoveKeywordsFromSynonymSet( _
    ByVal i_intEID As Long, _
    ByRef i_arrKeywords() As Long _
)

    Dim rs As ADODB.Recordset
    Dim strQuery As String
    Dim intIndex As Long
    
    If (UBound(i_arrKeywords) = 0) Then
        Exit Sub
    End If
    
    Set rs = New ADODB.Recordset
    
    strQuery = "" & _
        "SELECT * " & _
        "FROM Synonyms " & _
        "WHERE (EID = " & i_intEID & ") " & _
        "ORDER BY KID;"
        
    rs.Open strQuery, g_cnn, adOpenStatic, adLockPessimistic
    
    intIndex = 1
    
    Do While (Not rs.EOF)
        If (intIndex <= UBound(i_arrKeywords)) Then
            If (rs("KID") = i_arrKeywords(intIndex)) Then
                rs.Delete
                intIndex = intIndex + 1
            End If
        End If
        rs.MoveNext
    Loop

End Sub

' Consider only o_arrKeywordsToAdd(1..UBound) and o_arrKeywordsToRemove(1..UBound)

Private Sub p_GetKeywordsToAddAndRemove( _
    ByVal i_intEID As Long, _
    ByRef i_arrKeywords() As Long, _
    ByRef o_arrKeywordsToAdd() As Long, _
    ByRef o_arrKeywordsToRemove() As Long _
)
    Dim clsKeywords As Keywords
    Dim rs As ADODB.Recordset
    Dim intUBound As Long
    Dim intKeywordsIndex As Long
    Dim intAddIndex As Long
    Dim intRemoveIndex As Long
    Dim intCurrentKeywordInArray As Long
    Dim intCurrentKeywordInRS As Long
    
    Set clsKeywords = New Keywords
    Set rs = New ADODB.Recordset
    
    clsKeywords.GetKeywordsInSynonymSet i_intEID, rs, True
    InsertionSort i_arrKeywords
    
    ' In the worst case, we may have to add all Keywords in i_arrKeywords
    ReDim o_arrKeywordsToAdd(UBound(i_arrKeywords) - LBound(i_arrKeywords) + 1)
    
    ' In the worst case, we may have to remove all Keywords in rs
    ReDim o_arrKeywordsToRemove(rs.RecordCount + 1)
    
    intKeywordsIndex = 1
    intAddIndex = 1
    intRemoveIndex = 1
    intUBound = UBound(i_arrKeywords)
    
    Do While (Not rs.EOF)
    
        If (intKeywordsIndex <= intUBound) Then
            intCurrentKeywordInArray = i_arrKeywords(intKeywordsIndex)
        Else
            intCurrentKeywordInArray = INVALID_ID_C
        End If
        
        intCurrentKeywordInRS = rs("KID")
        
        If (intCurrentKeywordInArray = INVALID_ID_C) Then
            ' The Keyword in the RS isn't in the desired Keywords list
            o_arrKeywordsToRemove(intRemoveIndex) = intCurrentKeywordInRS
            intRemoveIndex = intRemoveIndex + 1
            rs.MoveNext
        Else
            
            If (intCurrentKeywordInArray < intCurrentKeywordInRS) Then
                ' The Keyword in the desired Keywords list isn't in the RS
                o_arrKeywordsToAdd(intAddIndex) = intCurrentKeywordInArray
                intAddIndex = intAddIndex + 1
                intKeywordsIndex = intKeywordsIndex + 1
            ElseIf (intCurrentKeywordInArray = intCurrentKeywordInRS) Then
                ' The Keyword in the desired Keywords list is already in the RS
                rs.MoveNext
                intKeywordsIndex = intKeywordsIndex + 1
            Else
                ' The Keyword in the RS isn't in the desired Keywords list
                o_arrKeywordsToRemove(intRemoveIndex) = intCurrentKeywordInRS
                intRemoveIndex = intRemoveIndex + 1
                rs.MoveNext
            End If
            
        End If
        
    Loop
    
    ' The remaining keywords in the desired Keywords list aren't in the RS
    
    Do While (intKeywordsIndex <= UBound(i_arrKeywords))
        intCurrentKeywordInArray = i_arrKeywords(intKeywordsIndex)
        
        If (intCurrentKeywordInArray <> INVALID_ID_C) Then
            o_arrKeywordsToAdd(intAddIndex) = intCurrentKeywordInArray
            intAddIndex = intAddIndex + 1
        End If
        
        intKeywordsIndex = intKeywordsIndex + 1
    Loop
    
    ReDim Preserve o_arrKeywordsToAdd(intAddIndex - 1)
    ReDim Preserve o_arrKeywordsToRemove(intRemoveIndex - 1)

End Sub

Private Sub p_ValidateSynonymSet( _
    ByVal i_strName As String _
)
    
    If (ContainsGarbage(i_strName)) Then
        Err.Raise errContainsGarbageChar
    End If

End Sub