451 lines
11 KiB
OpenEdge ABL
451 lines
11 KiB
OpenEdge ABL
|
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, Keywords.Keyword " & _
|
||
|
|
"FROM " & _
|
||
|
|
" Keywords INNER JOIN Synonyms " & _
|
||
|
|
" ON Keywords.KID = Synonyms.KID " & _
|
||
|
|
"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.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 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
|