Статья: Интеллектуальный поиск
Автор: Николай Малютин
Сообщение:
Предлагаемый метод предназначен для выполнения операции сравнения по приблизительным фразам. Например, если в большом списке поставщиков есть организация <ЗАО " Рога и Ка пыта" > (секретарша, вводя название в базу данных, сделала ошибку ;-), а Вы пытаетесь найти в нём по памяти <Копыта и Рога, ООО>, то при использовании традиционных методов поиска Вас, скорее всего, ждёт неудача. В предлагаемом решении Вы без труда сможете находить такие совпадения. Сам метод предложен Владимиром Кива, 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
Тема: Чтение и сохранение данных бинарного файла
Пример: 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 программе
Пример: 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 |