LEADERSOFT.ru Разработка на заказ программ и сайтов
ЕСЛИ БАЗА ВАМ НУЖНА В ЛИДЕРСОФТ ЗАЙДИ СПЕРВА!
Список всех статей ... Подписка на новости (рассылка через subscribe.ru)




































Выпуск 35. Интеллектуальный поиск

Подписка: "Access 2000 - программирование и готовые решения"
Дата:         22.02.2002
Сайт:         http://www.leadersoft.ru
  Новости
     22.02.2002. Вышла рассылка для специалистов "Профессионально об Access". Подробно рассматриваются 2 примера просмотра отчетов в форме, т.к. существующие версии Access 97-XP не позволяют просматривать отчеты в формах.
    22.02.2002. Добавились бесплатные примеры в файлы: la_find.mdb (3 интеллектуальный поиск), la_api.mdb (7 применение AdrressOf ), la_files.mdb (4 Чтение бинарного файла). Смотрите на сайте раздел: "Бесплатные коды".

Статья:  Интеллектуальный поиск
Автор:  Николай Малютин
Email:    malnik@mail.ru
Сообщение:
  
Предлагаемый метод предназначен для выполнения операции сравнения по приблизительным фразам. Например, если в большом списке поставщиков есть организация <ЗАО " Рога и Ка пыта" > (секретарша, вводя название в базу данных, сделала ошибку ;-), а Вы пытаетесь найти в нём по памяти <Копыта и Рога, ООО>, то при использовании традиционных методов поиска Вас, скорее всего, ждёт неудача. В предлагаемом решении Вы без труда сможете находить такие совпадения. Сам метод предложен Владимиром Кива: vlak@glasnet.ru, http://www.glasnet.ru/~vlak/similar/similar.html. В оригинале был приведен исходный код на C++ и библиотека. Я перевел код на VB и немного доработал, поэтому утилиту можно использовать в проектах БД
Дополнение от меня :
  Пожалуйста, посетите сайт, указанный выше, и изучите алгоритм поиска и лицензию на использование кодов на С++. Со своей стороны я только изменил название: "Нечеткое сравнение" на "Интеллектуальный поиск" и добавил пример 3 в файл la_find.mdb, где можно исследовать разные параметры сравнения текста. Прилагаемая программа работает с разными регистрами строк. Вот варианты примеров:
' 1. Сравнение с учетом регистра
' if IndistinctMatching(4, "test", "TEXT", vbBinaryCompare) > 40 then ...
' 2. Сравнение без учета регистра
' if IndistinctMatching(4, "test", "TEXT", vbTextCompare) > 40 then ...
Утилита IndistinctMatching возвращает число от 0 - 100, например, если число более 40, то можно говорить о совпадении фраз. Меняя это число, можно задавать разные условия поиска.
P.S. Я думаю, что тема интеллектуального поиска очень актуальная и интересная. Оригинально и то, что сам алгоритм и его реализация в VBA имеют короткие решения и не требуется каких-либо дополнительных словарей для сравнения. Попробуйте получше вникнуть в проблему, возможно и у Вас появятся еще идеи, так что тему еще можно продолжить ... 
Private Type RetCount
lngSubRows As Long
lngCountLike As Long
End Type

Public Function IndistinctMatching(lngMaxLen As Long, strStringMatching As String, strStringStandart As String, lngCase As Long) As Long
Dim gret As RetCount
Dim tret As RetCount
Dim lngCurLen As Long 'текущая длина подстроки

'если не передан какой-либо параметр, то выход
If lngMaxLen = 0 Or Len(strStringMatching) = 0 Or Len(strStringStandart) = 0 Then
IndistinctMatching = 0
Exit Function
End If

gret.lngCountLike = 0
gret.lngSubRows = 0
For lngCurLen = 1 To lngMaxLen
'Сравниваем строку A со строкой B
tret = MatchingStrings(strStringMatching, strStringStandart, lngCurLen, lngCase)
gret.lngCountLike = gret.lngCountLike + tret.lngCountLike
gret.lngSubRows = gret.lngSubRows + tret.lngSubRows
'Сравниваем строку B со строкой A
tret = MatchingStrings(strStringStandart, strStringMatching, lngCurLen, lngCase)
gret.lngCountLike = gret.lngCountLike + tret.lngCountLike
gret.lngSubRows = gret.lngSubRows + tret.lngSubRows
Next lngCurLen

If gret.lngSubRows = 0 Then
IndistinctMatching = 0
Exit Function
End If
IndistinctMatching = (gret.lngCountLike / gret.lngSubRows) * 100
End Function

Private Function MatchingStrings(strA As String, strB As String, lngLen As Long, lngCase As Long) As RetCount
Dim tret As RetCount
Dim y As Long, z As Long
Dim strta As String
Dim strtb As String
For z = 1 To Len(strA) - lngLen + 1
strta = Mid(strA, z, lngLen)
y = 1
For y = 1 To Len(strB) - lngLen + 1
strtb = Mid(strB, y, lngLen)
If StrComp(strta, strtb, lngCase) = 0 Then
tret.lngCountLike = tret.lngCountLike + 1
Exit For
End If
Next y
tret.lngSubRows = tret.lngSubRows + 1
Next z
MatchingStrings.lngCountLike = tret.lngCountLike
MatchingStrings.lngSubRows = tret.lngSubRows
End Function
Вопрос:  1738
Тема:      Чтение и сохранение данных бинарного файла
Ссылка: http://www.leadersoft.ru/cgi-bin/rusboard/data/1738.htm
Пример: la_files.mdb (4 пример)
Сообщение:
  Подскажите, как можно получить произвольную часть бинарного кода файла и присвоить его некоторой переменной?
Ответ. Способ чтения файла достаточно простой и описан в документации. Сложности возникают при чтении данных в переменные и преобразование их к нужному виду. Ниже указан пример, который Вы можете использовать для загрузки, например, файла dbf и написания своего конвертера для чтения табличных данных в Access. Сначала Вам необходимо будет прочитать заголовок dbf файла, определить длину записи, а потом уже можно будет читать/сохранять их во внешнем файле. Полное описание программы дано в 4 примере файла la_files.mdb
' Описываем структуру записи
Private Type AppRecord
ID As Integer
Name1 As String * 20
Phone1 As Long
Date1 As Date
End Type

' Читаем бинарный файл
Private Sub butRead_Click()
Dim intFile As Integer ' Указатель на файл
Dim myRec As AppRecord ' Мои данные

intFile = FreeFile() ' Создаем указатель
Open Me.strPath For Binary As #intFile
Get #intFile, 1, myRec ' Читаем данные (1-номер позиции)
Close #intFile ' Освобождаем память
End Sub
Вопрос:  1741
Тема:      Применение пользовательской функции в API программе
Ссылка: http://www.leadersoft.ru/cgi-bin/rusboard/data/1741.htm
Пример: la_api.mdb (7 пример)
Сообщение:
   Как в приведенном ниже коде правильно указать адрес вызываемой функции: lpFunction.
   Declare Function timeSetEvent Lib "winmm.dll" (ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpFunction As Long, ByVal dwUser As Long, ByVal uFlags As Long) As Long
  Примечание. Данная функция необходима для запуска таймера, т.е. для выполнения каких либо действий в программе через равные промежутки времени. Аналог в "Панели управления" раздела "Назначенные задания".
  Ответ.
  Для определения адреса вызываемой функции служит оператор AddressOf , в документации он не описан. Вызов функции в VBA выглядит примерно так:
hTimer = timeSetEvent(uDelay, uResolution, AddressOf funTimerProc, dwUser, uFlags)
funTimerProc - эта Ваша программа и должна быть описана во внешнем модуле. Она имеет несколько параметров и использование ее дано в 7 примере la_api.mdb. Само описание функции выглядит так:
Public Function funTimerProc(ByVal uID As Long, ByVal uMsg As Long, ByVal dwUser As Long, ByVal dw1 As Long, ByVal dw2 As Long) As Long
Вопрос:  1746
Тема:      Использование dll программ
Ссылка: http://www.leadersoft.ru/cgi-bin/rusboard/data/1746.htm
Сообщение: Хочу загрузить в Word следующие файлы: msgrRU32.dll, msth32.dll. Как мне это сделать?
Ответ. Эти библиотеки отвечают за грамматику в офисе: орфография, тезаурус, переносы. Ищите их в следующих папках.
c:\Program Files\Common Files\Microsoft Shared\Proof\MSTHRU32.DLL
c:\Program Files\Common Files\Microsoft Shared\Proof\1049\MSGRRU32.DLL
Библиотеки не будут работать в программе, если Вы не сможете их правильно зарегистрировать в реестре, т.е. надо сравнить ссылки в вашем реестре с другим, где установлен правильный - "русский" офис и "прописать" их у себя.
Примечание. Вопрос не очень точный, но можно предположить, что Вы возможно собираетесь использовать какие-то функции из этих библиотек. Стандартный способ применения ссылок такой. Откройте редактор VBA. Далее смотрите меню: Tools-References-Browse. Выберите необходимую библиотеку и просмотрите ее функции. В данном случае это невозможно сделать, и поэтому придется самому искать описание этих библиотек. Применение функций будет такое же как и в API интерфейсе.