windows-server-2003/admin/pchealth/authtools/prodtools/authdatabase/keywordifier.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 = "Keywordifier"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private p_clsKeywords As Keywords
Private p_dictKIDs As Scripting.Dictionary
Private p_dictStopWords As Scripting.Dictionary
Private p_dictStopSigns As Scripting.Dictionary

Private Sub Class_Initialize()
    
    Dim clsStopWords As StopWords
    Dim clsStopSigns As StopSigns
    Dim rs As ADODB.Recordset
    
    Set clsStopWords = New StopWords
    Set clsStopSigns = New StopSigns
    Set rs = New ADODB.Recordset
        
    Set p_clsKeywords = New Keywords
    Set p_dictKIDs = New Scripting.Dictionary
    Set p_dictStopWords = New Scripting.Dictionary
    Set p_dictStopSigns = New Scripting.Dictionary

    p_dictKIDs.CompareMode = TextCompare
    p_clsKeywords.GetAllKeywordsDict p_dictKIDs

    p_dictStopWords.CompareMode = TextCompare
    clsStopWords.GetAllStopWordsRs rs

    Do While (Not rs.EOF)
        p_dictStopWords.Add rs("StopWord").Value, True
        rs.MoveNext
    Loop

    clsStopSigns.GetAllStopSignsRs rs

    Do While (Not rs.EOF)
        p_dictStopSigns.Add rs("StopSign").Value, rs("Context").Value
        rs.MoveNext
    Loop

End Sub

Private Sub Class_Terminate()

    Set p_clsKeywords = Nothing
    Set p_dictKIDs = Nothing
    Set p_dictStopWords = Nothing
    Set p_dictStopSigns = Nothing

End Sub

Public Function CreateKeywordsFromTitle( _
    ByVal i_strTitle As String _
) As String

    Dim str As String
    Dim arrStr() As String
    Dim intIndex As Long
    Dim arrKeywords() As String
    Dim intKeywordIndex As Long
    
    Const NUM_WORDS_C As Long = 2
    
    ReDim arrKeywords(NUM_WORDS_C)
    intKeywordIndex = 0
    
    str = RemoveOperatorShortcuts(i_strTitle)
    str = p_RemoveStopSigns(str)
    str = RemoveExtraSpaces(str)

    ' Create a mondo keyword from the title
    ' CreateKeywordsFromTitle = " " & GetKID(str, True) & " "
    CreateKeywordsFromTitle = " "
    
    arrStr = Split(str)
    
    For intIndex = LBound(arrStr) To UBound(arrStr)
        str = arrStr(intIndex)
        If (str <> "") Then
            If (Not IsVerbalOperator(str)) Then
                If (Not p_dictStopWords.Exists(str)) Then
                    CreateKeywordsFromTitle = CreateKeywordsFromTitle & _
                        GetKID(str) & " "
'                    If (intKeywordIndex < NUM_WORDS_C) Then
'                        intKeywordIndex = intKeywordIndex + 1
'                        arrKeywords(intKeywordIndex) = str
'                    End If
                End If
            End If
        End If
    Next
    
'    str = " "
'    For intIndex = 1 To intKeywordIndex
'        If (intIndex = 1) Then
'            str = arrKeywords(intIndex)
'        Else
'            str = str & " " & arrKeywords(intIndex)
'            CreateKeywordsFromTitle = CreateKeywordsFromTitle & GetKID(str) & " "
'        End If
'    Next
    
    CreateKeywordsFromTitle = FormatKeywordsForTaxonomy(CreateKeywordsFromTitle)

End Function

Public Function GetKID( _
    ByRef i_strKeyword As String, _
    Optional ByVal i_blnMinValidation As Boolean = False _
) As String
    
    Dim intKID As Long

    If (p_dictKIDs.Exists(i_strKeyword)) Then
        GetKID = p_dictKIDs(i_strKeyword)
    Else
        intKID = p_CreateKeyword(i_strKeyword, i_blnMinValidation)

        If (intKID <> INVALID_ID_C) Then
            p_dictKIDs.Add i_strKeyword, intKID
            GetKID = intKID
        End If
    End If

End Function

Private Function p_CreateKeyword( _
    ByRef i_strKeyword As String, _
    ByVal i_blnMinValidation As Boolean _
) As Long

    On Error GoTo LErrorHandler

    p_CreateKeyword = p_clsKeywords.Create(i_strKeyword, i_blnMinValidation)

    Exit Function

LErrorHandler:

    p_CreateKeyword = INVALID_ID_C

End Function

Private Function p_RemoveStopSigns( _
    ByVal i_strText As String _
) As String

    Dim intIndex As Long
    Dim intLength As Long
    Dim str As String
    Dim char As String

    str = i_strText
    intLength = Len(str)

    For intIndex = intLength To 1 Step -1
        char = Mid$(str, intIndex, 1)
        If (p_dictStopSigns.Exists(char)) Then
            If (p_dictStopSigns(char) = CONTEXT_ANYWHERE_E) Then
                ' Replace the character with a space
                str = Mid$(str, 1, intIndex - 1) & " " & Mid$(str, intIndex + 1)
            ElseIf (intIndex > 1) Then
                ' Context is CONTEXT_AT_END_OF_WORD_E, and this isn't the first char
                If (Mid$(str, intIndex - 1, 1) <> " ") Then
                    ' Previous character is not a space
                    If ((intIndex = intLength) Or (Mid$(str, intIndex + 1, 1) = " ")) Then
                        ' This is the last character or the next character is a space
                        ' Replace the character with a space
                        str = Mid$(str, 1, intIndex - 1) & " " & Mid$(str, intIndex + 1)
                    End If
                End If
            End If
        End If
    Next

    p_RemoveStopSigns = str

End Function