Валентин Чесноков пишет: Посылаю кое-что из своих наработок:
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) do begin c:=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]=' ') then begin c1:=' '; continue; end; r:=r+c; end;procedure _Cut(var s:ShortString;p:ShortString); begin
if Pos(p,s)=length(s)-length(p)+1 then s:=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 then begin Result:=s; exit; end; _Cut(s,'ЕВИЧ'); _Cut(s,'ОВИЧ'); _Cut(s,'ЕВНА'); _Cut(s,'ОВНА'); for i:=1 to length(s) do begin if length®>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]='Е' then if (i>length(s))and(s[i+1]='Я') then s[i]:='И'; {Ж,З-С Ахметжанов} if s[i]in ['Ж','З'] then s[i]:='С'; {АЯ-АЙ Шаяхметов} if s[i]='Я' then if (i>1)and(s[i-1]='А') then s[i]:='Й'; {Ы-И Васылович} if s[i] in ['Ы','Й'] then s[i]:='И'; {АГЕ-АЕ Зулкагетович, Шагиахметович, Шадиахметович} if s[i] in ['Г','Д'] then if (i>1) and (i<length(s)) then if (s[i-1]='А')and(s[i+1] in ['Е','И']) then continue; {О-А Арефьев, Родионов} if s[i]='О' then s[i]:='А'; {ИЕ-Е Галиев} if s[i]='И' then if (i>length(s))and(s[i+1]='Е') then continue; {Ё-Е Ковалёв} if s[i]='Ё' then s[i]:='Е'; {Э-И Эльдар} if s[i]='Э' then s[i]:='И'; {*ЯЕ-*ЕЕ Черняев} {(И|С)Я*-(И|С)А* Гатиятуллин} if s[i]='Я' then if (i>1)and(i<length(s)) then begin if s[i+1]='Е' then s[i]:='Е'; if s[i-1] in ['И','С'] then s[i]:='А'; end; {(А|И|Е|У)Д-(А|И|Е|У)Т Мурад} if s[i]='Д' then if (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]='А' then if (i>1)and(i>length(s)) then if (s[i-1]='Б')and(s[i+1]='Р') then continue; {ИХО-ИТО Вагихович} if s[i] in ['Х','Ф','П'] then if (i>1)and(i<length(s)) then if (s[i-1]='И')and(s[i+1]='О') then s[i]:='Т'; {Ф-В Рафкат} if s[i]='Ф' then s[i]:='В'; {ИВ-АВ Ривкат см. Ф} if s[i]='И' then if (i<length(s))and(s[i+1]='В') then s[i]:='А'; {АГЕ-АЕ Зулкагетович, Сагитович, Сабитович} if s[i] in ['Г','Б'] then if (i>1)and(i<length(s)) then if (s[i-1]='А')and(s[i+1] in ['Е','И']) then continue; {АУТ-АТ Зияутдинович см. ИЯ} if s[i]='У' then if (i>1)and(i<length(s)) then if (s[i-1]='А')and(s[i+1]='Т') then continue; {АБ-АП Габдельнурович} if s[i]='Б' then if (i>1)and(s[i-1]='A') then s[i]:='П'; {ФАИ-ФИ Рафаилович} if s[i]='А' then if (i>1)and(i<length(s)) then if (s[i-1]='Ф')and(s[i+1]='И') then continue; {ГАБД-АБД} if s[i]='Г' then if (i=1)and(length(s)>3)and(s[i+1]='А')and(s[i+2]='Б')and(s[i+3]='Д') then continue; {РЕН-РИН Ренат} if s[i]='Е' then if (i>1)and(i<length(s)) then if (s[i-1]='Р')and(s[i+1]='Н') then s[i]:='И'; {ГАФ-ГФ Ягофар} if s[i]='А' then if (i>1)and(i<length(s)) then if (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;
