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