Советы по Delphi



Работа с индексами Clipper'а


пишет:

Посылаю кое-что из своих наработок:

NtxRO - Модуль чтения clipper-овских индексов. Удобен для доступа к данным Clipper приложений. Предусмотрено, что программа может работать с индексом даже если родное приложение производит изменение в индексе NtxAdd - Средство формирования своих Clipper подобных индексов. Индексы НЕ БУДУТ ЧИТАТЬСЯ Clipper-приложениями (кое-что не заполнил в заголовке, очень было лениво, да и торопился) До модуля удаления из Индекса ключей все никак не дойдут руки. Меня очень интересуют аналогичные разработки для индексов Fox-а Кстати реализация индексов Clipper наиболее близка из всех к тому, что описано у Вирта в "Алгоритмах и структурах данных"

Я понимаю, что мне могут возразить, что есть дескать Apollo и т.п., но я считаю что предлагаемая реализация наиболее удобна ТАК КАК ИНДЕКСЫ НЕ ПРИВЯЗАНЫ К НАБОРУ ДАННЫХ (а лишь поставляют физические номера записей) это позволяет делать кое-какие фокусы (например перед индексацией преобразовать значение какой нибудь функцией типа описанной ниже, не включать индексы для пустых ключевых значений в разреженных таблицах, строить индексы контекстного поиска, добавляя по нескольку значений на одну запись, строить статистики эффективности поиска различных ключевых значений (для фамилии Иванов например статистика будет очень плохой) и т.п.)

В файле Eurst.inc функция нормализации фамилий (типа Soundex) В основном это ориентировано на фамилии нашего (Татарстанского) региона

Файл Eurst.inc

var vrSynonm:integer=0;vrPhFine:integer=0;vrUrFine:integer=0;vrStrSyn:integer=0;
function fContxt(const s:ShortString):ShortString;
var i:integer;
r:ShortString;c,c1:char;begin r:=''; c1:=chr(0);
for i:=1 to length(s) dobeginc:=s[i];if c='Ё' then c:='Е';if not (c in ['А'..'Я','A'..'Z','0'..'9','.']) then c:=' ';if (c=c1)and not (c1 in ['0'..'9']) then continue;c1:=c;if (c1 in ['А'..'Я'])and(c='-')and(i<length(s))and(s[i+1]=' ') thenbeginc1:=' ';continue;end;r:=r+c;end;procedure _Cut(var s:ShortString;p:ShortString);
begin
if
Pos(p,s)=length(s)-length(p)+1 thens:=Copy(s,1,length(s)-length(p));end;

function _PhFace(const ss:ShortString):ShortString;
var r:ShortString;
i:integer;s:ShortString;begin r:='';s:=ANSIUpperCase(ss);if length(s)<2 thenbeginResult:=s;exit;end;_Cut(s,'ЕВИЧ');_Cut(s,'ОВИЧ');_Cut(s,'ЕВНА');_Cut(s,'ОВНА');for i:=1 to length(s) dobeginif length(r)>12 then break;if not(s[i] in ['А'..'Я','Ё','A'..'Z']) then break;if (s[i]='Й')and((i=length(s))or(not (s[i+1] in ['А'..'Я','Ё','A'..'Z']))) then continue;{ЕЯ-ИЯ Андриянов}if s[i]='Е' thenif (i>length(s))and(s[i+1]='Я') then s[i]:='И';{Ж,З-С Ахметжанов}if s[i]in ['Ж','З'] then s[i]:='С';{АЯ-АЙ Шаяхметов}if s[i]='Я' thenif (i>1)and(s[i-1]='А') then s[i]:='Й';{Ы-И Васылович}if s[i] in ['Ы','Й'] then s[i]:='И';{АГЕ-АЕ Зулкагетович, Шагиахметович, Шадиахметович}if s[i] in ['Г','Д'] thenif (i>1) and (i<length(s)) thenif (s[i-1]='А')and(s[i+1] in ['Е','И']) then continue;{О-А Арефьев, Родионов}if s[i]='О' then s[i]:='А';{ИЕ-Е Галиев}if s[i]='И' thenif (i>length(s))and(s[i+1]='Е') then continue;{Ё-Е Ковалёв}if s[i]='Ё' then s[i]:='Е';{Э-И Эльдар}if s[i]='Э' then s[i]:='И';{*ЯЕ-*ЕЕ Черняев}{(И|С)Я*-(И|С)А* Гатиятуллин}if s[i]='Я' thenif (i>1)and(i<length(s)) thenbeginif s[i+1]='Е' then s[i]:='Е';if s[i-1] in ['И','С'] then s[i]:='А';end;{(А|И|Е|У)Д-(А|И|Е|У)Т Мурад}if s[i]='Д' thenif (i>1)and(s[i-1] in ['А','И','Е','У']) then s[i]:='Т';{Х|К-Г Фархат}if s[i] in ['Х','К'] then s[i]:='Г';if s[i] in ['Ь','Ъ'] then continue;{БАР-БР Мубракзянов}if s[i]='А' thenif (i>1)and(i>length(s)) thenif (s[i-1]='Б')and(s[i+1]='Р') then continue;{ИХО-ИТО Вагихович}if s[i] in ['Х','Ф','П'] thenif (i>1)and(i<length(s)) thenif (s[i-1]='И')and(s[i+1]='О') then s[i]:='Т';{Ф-В Рафкат}if s[i]='Ф' then s[i]:='В';{ИВ-АВ Ривкат см. Ф}if s[i]='И' thenif (i<length(s))and(s[i+1]='В') then s[i]:='А';{АГЕ-АЕ Зулкагетович, Сагитович, Сабитович}if s[i] in ['Г','Б'] thenif (i>1)and(i<length(s)) thenif (s[i-1]='А')and(s[i+1] in ['Е','И']) then continue;{АУТ-АТ Зияутдинович см. ИЯ}if s[i]='У' thenif (i>1)and(i<length(s)) thenif (s[i-1]='А')and(s[i+1]='Т') then continue;{АБ-АП Габдельнурович}if s[i]='Б' thenif (i>1)and(s[i-1]='A') then s[i]:='П';{ФАИ-ФИ Рафаилович}if s[i]='А' thenif (i>1)and(i<length(s)) thenif (s[i-1]='Ф')and(s[i+1]='И') then continue;{ГАБД-АБД}if s[i]='Г' thenif (i=1)and(length(s)>3)and(s[i+1]='А')and(s[i+2]='Б')and(s[i+3]='Д') then continue;{РЕН-РИН Ренат}if s[i]='Е' thenif (i>1)and(i<length(s)) thenif (s[i-1]='Р')and(s[i+1]='Н') then s[i]:='И';{ГАФ-ГФ Ягофар}if s[i]='А' thenif (i>1)and(i<length(s)) thenif (s[i-1]='Г')and(s[i+1]='Ф') then continue;{??-? Зинатуллин}if (i>1)and(s[i]=s[i-1]) then continue;r:=r+s[i];end;Result:=r;end;
<


Содержание    Вперед