RecognizerClass
Option Explicit ' Будем все делать правильно

' Ключевая строка кода
' Чтобы наш класс воспринимался Office, надо
' использовать интерфейс ISmartTagRecognizer

Implements ISmartTagRecognizer



Private Sub Class_Initialize()
' Здесь приведена заглушка, в реальном приложении
' нужно получить список терминов из файла или сети
' в противном случае понадобится перекомпиляция всякий раз
' как бедет добавлен новый термин
Dim tData As Data

ReDim knownTerms(3)
Set termData = New DataCollection

knownTerms(0) = "gaidar"
Set tData = termData.Add("gaidar", "gaidar")
tData.ID = "109"
tData.Mail = "gaidar@vbstreets.ru"
tData.Url = "gaidar.com.ru"

knownTerms(1) = "asd"
Set tData = termData.Add("asd", "asd")
tData.ID = "3"
tData.Mail = "admin@vbstreets.ru"
tData.Url = "www.vbstreets.ru"

knownTerms(2) = "moderator"
Set tData = termData.Add("moderator", "moderator")
tData.ID = "33"
tData.Mail = "anton@vbstreets.ru"
tData.Url = "www.bitshape.ru"

knownTerms(3) = "rayshade"
Set tData = termData.Add("rayshade", "rayshade")
tData.ID = "1974"
tData.Mail = "rayshade@vbstreets.ru"
tData.Url = "www.vbstreets.ru"

End Sub

Private Sub Class_Terminate()
' Здесь ничего не делаем

End Sub

Private Property Get ISmartTagRecognizer_Desc(ByVal LocaleID As Long) As String
' Описание класса
ISmartTagRecognizer_Desc = "Компонент распознования ников модераторов форума"
End Property

Private Property Get ISmartTagRecognizer_Name(ByVal LocaleID As Long) As String
' Имя будет отображаться в Microsoft Word в меню
' Tools -> Autocorrect Option -> Smart Tags
ISmartTagRecognizer_Name = "VBStreets Nick Recognizer"
End Property

Private Property Get ISmartTagRecognizer_ProgId() As String
' Уникальное имя
ISmartTagRecognizer_ProgId = "VBS_SmartTags.RecognizerClass"
End Property

Private Sub ISmartTagRecognizer_Recognize(ByVal Text As String, ByVal DataType As _
SmartTagLib.IF_TYPE, ByVal LocaleID As Long, ByVal RecognizerSite As _
SmartTagLib.ISmartTagRecognizerSite)

' Процесс распознавания необычайно прост, достаточно найти
' в переданном в качестве параметра тексе имеющиеся в списке
' термины
Dim i As Integer, stStart As Integer, stLength As Integer
Dim SmartTagPB As SmartTagLib.ISmartTagProperties
' Прежде всего необходимо следить за тем, чтобы регистр text и
' регистр терминов был одинаковый, иначе поиск с помощью InStr
' закончится неудачей

Text = LCase(Text)

' Проходим в цикле через массив терминов
For i = 0 To UBound(knownTerms)
' вычисляем длину термина в символах
stLength = Len(knownTerms(i))
' ищем термин в тексте
stStart = InStr(1, Text, LCase(knownTerms(i)))
' если термин присутствует в тексте, ищем его еще раз
Do While (stStart <> 0)
' Создаем новый объект SmartTag Property Bag
Set SmartTagPB = RecognizerSite.GetNewPropertyBag
' У нас только один тип SmartTags в компоненте
' поэтому схема везде одна, потому-то она и
' константа
Call RecognizerSite.CommitSmartTag(SchemaName, stStart, stLength, SmartTagPB)
' нет ли еще тут чего-нибудь
stStart = InStr(stStart + stLength, Text, knownTerms(i))
Loop
Next i

End Sub

Private Property Get ISmartTagRecognizer_SmartTagCount() As Long
' Количество распозноваемых типов SmartTags
' В нашем примере тип только один - ники модераторов
' форума VBStreets
ISmartTagRecognizer_SmartTagCount = 1
End Property

Private Property Get ISmartTagRecognizer_SmartTagDownloadURL(ByVal SmartTagID As Long) _
As String
' Наш компонент не поддерживает эту фичу, для простоты примера
ISmartTagRecognizer_SmartTagDownloadURL = ""
End Property

Private Property Get ISmartTagRecognizer_SmartTagName(ByVal SmartTagID As Long) As String
' Название типов поддерживаемых SmartTags
' формат: namespaceURI#tagname
Select Case SmartTagID
Case 1:
ISmartTagRecognizer_SmartTagName = SchemaName
End Select
End Property

ActionClass

Option Explicit

' Ключевая строка кода
' Чтобы наш класс воспринимался Office, надо
' использовать интерфейс ISmartTagAction

Implements ISmartTagAction

Private Sub Class_Initialize()
' ничего тут не делаем
End Sub

Private Sub Class_Terminate()
' да и тут тоже ничего
End Sub


Private Property Get ISmartTagAction_Desc(ByVal LocaleID As Long) As String
' Описание
ISmartTagAction_Desc = "Обработка распознаных ников"
End Property

Private Sub ISmartTagAction_InvokeVerb(ByVal VerbID As Long, ByVal ApplicationName As _
String, ByVal Target As Object, ByVal Properties As SmartTagLib.ISmartTagProperties, ByVal _
Text As String, ByVal Xml As String)
' Выполняем затребованное пользователем действие
' Для простоты переложим всю работу на ShellExecute

Dim tData As New Data
Set tData = termData.Item(LCase(Text))
Select Case VerbID
Case 1:
ShellExecute 0, vbNullString, "http://bbs.vbstreets.ru/profile.php?mode=viewprofile&u=" _
 & tData.ID, vbNullString, vbNullString, SW_SHOWNORMAL
Case 2:
ShellExecute 0, vbNullString, "mailto:" & tData.Mail, vbNullString, vbNullString,_
 SW_SHOWNORMAL
Case 3:
ShellExecute 0, vbNullString, "http://" & tData.Url, vbNullString, vbNullString,_
 SW_SHOWNORMAL
End Select
End Sub

Private Property Get ISmartTagAction_Name(ByVal LocaleID As Long) As String
' Описание
ISmartTagAction_Name = "VBS Forum Nicks Actions Class"
End Property

Private Property Get ISmartTagAction_ProgId() As String
' Уникальное имя
ISmartTagAction_ProgId = "VBS_SmartTags.ActionClass"
End Property

Private Property Get ISmartTagAction_SmartTagCaption(ByVal SmartTagID As Long,_
 ByVal LocaleID As Long) As String
' Этот текст будет видеть пользователь в качестве заголовка
ISmartTagAction_SmartTagCaption = "VBS Forum Nicks"
End Property

Private Property Get ISmartTagAction_SmartTagCount() As Long
' Количество распозноваемых типов SmartTags
' В нашем примере тип только один - ники модераторов
' форума VBStreets
ISmartTagAction_SmartTagCount = 1
End Property

Private Property Get ISmartTagAction_SmartTagName(ByVal SmartTagID As Long) As String
' Название типов поддерживаемых SmartTags
' формат: namespaceURI#tagname
Select Case SmartTagID
Case 1:
ISmartTagAction_SmartTagName = SchemaName
End Select
End Property

Private Property Get ISmartTagAction_VerbCaptionFromID(ByVal VerbID As Long,_
 ByVal ApplicationName As String, ByVal LocaleID As Long) As String
' Название действия (VerbCaption), которое
' будет видеть пользователь
Select Case VerbID
Case 1:
ISmartTagAction_VerbCaptionFromID = "Помотреть профиль на форуме"
Case 2:
ISmartTagAction_VerbCaptionFromID = "Послать письмо"
Case 3:
ISmartTagAction_VerbCaptionFromID = "Посмотреть домашнюю страницу"
End Select
End Property

Private Property Get ISmartTagAction_VerbCount(ByVal SmartTagName As String) As Long
' Возвращаем количество выполняемых действий
Select Case SmartTagName
Case SchemaName
ISmartTagAction_VerbCount = 3 ' всего три действия
End Select
End Property

Private Property Get ISmartTagAction_VerbID(ByVal SmartTagName As String, ByVal_
 VerbIndex As Long) As Long
' ID действия
' у нас всего три действия для одного типа
' SmartTags поэтому Index = ID
Select Case SmartTagName
Case SchemaName
ISmartTagAction_VerbID = VerbIndex
End Select
End Property

Private Property Get ISmartTagAction_VerbNameFromID(ByVal VerbID As Long) As String
' Имя действия (VerbID)
' на каждое по своему имени
' в дальнейшем они используются в Office, например
' для взаимодействия VBA программам с этим компонентом SmartTags
Select Case VerbID
Case 1:
ISmartTagAction_VerbNameFromID = "viewProfile"
Case 2:
ISmartTagAction_VerbNameFromID = "sendMail"
Case 3:
ISmartTagAction_VerbNameFromID = "viewHomePage"
End Select

End Property