Склонение ФИО в дательном падеже (для доверенностей, почтовых переводов и прочее). Версия 2.1

Данная задача впервые возникла у меня еще 02.12.1998 при написании модуля на интерпретаторе, написанном на Clipper (лишенном конструкции CASE), для формирования доверенностей. Позже задача всплыла уже на VFP для формирования имени получателя в дательном падеже в бланке почтового перевода. Благодаря ценным замечаниям waw и жы-шы 28.02.2007 г. создана исправленная версия 2.1

Что нового в версии 2.1 от 28.02.2007 г.:
1. Добавлена обработка грузинских (на "ИА","ИЯ") и некоторых французских фамилий-исключений
2. Особо обрабатывается склонение женских грузинских фамилий типа "ОкуджаВА" (по окончанию не отличается от русской)
3. Переписана обработка фамилий на "ОК" и "ЕК"
4. Список последних букв, встречающихся в типичных мужских именах существенно расширен практически до всех согласных
5. Расширен список № 1 иностранных фамилий, оканчивающихся на согласный звук, дополняющихся буквой "У" у мужчин,
однако он пока еще не полный

Что нового в версии 2.0 от 26.02.2007 г.:
1. Добавлена обработка мужских имен на "ья" (Илья)
2. Добавлена обработка мужского имени "Лев"
3. Более тщательно переписана обработка фамилий, заканчивающихся на "ец". Рассмотрены разные случаи...
4. Более четко анализируются фамилии на "ий" (-ому, -ему) и "ая" (-ой, -ей)
5. Исправлено склонение фамилии на -ия у мужчин и запрещено у женщин
6. Фамилии на -уа больше не склоняются
7. Особо обрабатываются фамилии исключения типа Бокий (-ию)
8. Повторяющиеся коды обработки мужского и женского имен помечены в виде отдельных блоков-процедур

Предупреждаю сразу - я не лингвист и рядом даже не стоял. Тем не менее рецензия грамотного лингвиста, включающая все советы и замечания по данной процедуре, была бы здесь очень желательна и уместна. Поэтому, ввиду отсутствия рецензии лингвиста на данном этапе, прошу вас за найденные ошибки сильно меня не ругать и не пинать, но все ваши ценные замечания с благодарностью приму! Хочу отметить, что приведенная ниже моя разработка, не смотря на все ее очевидные недостатки и достоинства, тем не менее, с 1998 года успешно работает и по сей день. Если не затруднит, то помогите советом по ее улучшению и сообщениями о найденных багах!

Теперь о том, что в коде не хватает:
1. Грамотная обработка встречающихся в России, но не русских по происхождению имен с "ОГЛЫ", "АТА" и т.п.
2. Перечень разнообразных имен и фамилии, а также разных "исключений" из правил формировался в основном
на базе телефонного справочника г.Тамбова. А Тамбов город маленький (всего 300 тыс. жителей), поэтому
наверняка вы придумаете еще пару редких склоняемых фамилий, которые для задачи склонения просьба огласить
ниже в комментариях для народного обсуждения...
3. Можно и нужно переписать функцию с использованием конструкции DO CASE и избавиться от многочисленных "IF"

      
  * Процедура GetDativ склонения ФИО получателя в дательном падеже (кому?).    
  * Версия 2.1 исправленная. Обсуждение проекта также здесь: gramota.ru    
  * Приведенный код может содержать ошибки, но Вы можете свободно использовать его на свой страх и риск.    
  * Тестирование продолжается. Присылайте и пишите свои отзывы и замечания. Спасибо всем откликнувшимся!    
  * Полезные ссылки:    
  * Особенности склонения фамилий и личных имен spravka.gramota.ru Отсюда взяты правила!    
  * Склонение личных имен в русском языке www.nazovite.ru    
  * Cловари русского языка для скачивания dicts.alphanet.org.ua    
  * По последней ссылке можно скачать в т.ч. словарь фамилий familii.exe 2,160,669 байт (7 миллионов фамилий)    
  * Книга: "Склонение фамилий и личных имен в русском литературном языке."    
  * Автор: Калакуцкая Л.П., Издание: М. ; Наука 1984г, Страниц: 221    
  * Книга: "Современные русские фамилии."    
  * Автор: Суперанская А.В., Суслова А.В. Издание: М. ; Наука 1981г, Страниц: 176    
  * На с. 120-122 последнего издания приводятся русские фамилии на "ой", "ий", "ый", без показателя (суффикса) "ск", как в фамилии КрамСКой)    
        
    LPARAM lFIO    
    LOCAL Fam, Ima, Otc, ManLstLt, WmnLstLt, ManFamEnd, IiFamEnd, WmnFamEnd, ;    
    	  Jud1FamEnd, Jud2FamEnd, Jud3FamEnd, FranceFam, LstLtIma, LstTwoIma, ;    
    	  LstLtFam, LstTwoFam, LstTwoOtc, Processed, Sex, lDefisPos    
        
    Fam = SubStr(lFIO,1,At(" ",lFIO)-1) && Фамилия, Имя, Отчетво    
    Ima = AfterAtNum(" ",lFIO,1)        && потребуются для процедуры склонения    
    Ima = SubStr(Ima,1,At(" ",Ima)-1)   && их в дательном падеже (кому?)    
    Otc = AfterAtNum(" ",lFIO,2)    
        
  * Список всех гласных букв русского алфавита (требуются для проверки букв, стоящих перед окончаниями сложных фамилий)    
    Vowels    = 'АЕЁИОУЭЫЮЯ'    
  * Список шипящих букв, необходимых для правильного склонения фамилий, заканчивающихся на эта буква + "ИЙ" или "АЯ"    
    Hissing   = 'ЧШЩ'    
  * Список последних букв, встречающихся в типичных мужских именах    
  * ГлеБ,СлаВ,ОлеГ,ЭдуарД(АльфреД),ГилядЖ,ЧингиЗ,МарК,МихаиЛ,ВадиМ,ИваН,ЮсуП,ВиктоР,БориС(ФеликС),ФилареТ(МараТ),ИосиФ,АристарХ    
    ManLstLt  = 'БВГДЖЗКЛМНПРСТФХ'    
  * Список последних букв, встречающихся в типичных женских именах    
    WmnLstLt  = 'АЯЬ'  && МаринА, АнастасиЯ, ИЯ (исключение), ЛюбовЬ    
  * Список окончаний мужских славянских (русских) фамилий. На -ов фамилии отцовы, на -ин фамилии мамины.    
    ManFamEnd = 'ЕВ ЁВ ИН ОВ ЫН'    
  * Список окончаний мужских славянских (русских) фамилий, заканчивающихся на 'Й'    
  * Чисто русские фамилии без "-ск-": БлагОЙ,ТолстОЙ,БоровОЙ,БереговОЙ,ЛановОЙ,БроневОЙ,ДикИЙ,ГладкИЙ,ЛучшИЙ,ПоперечнЫЙ,...    
  * Существует ряд воспринимаемых неоднозначно фамилии ТопчИЙ, ПобожИЙ, БокИЙ, РудОЙ и т.п.,    
  * как имеющих окончания "-ий","-ой", и склоняющихся как прилагательные (ТопчИЙ->ТопчЕМУ /жен.ТопчЕЙ/)    
  * или как с нулевым окончанием и склонением по образцу существительных (ТопчИЙ->ТопчИЮ /жен.ТопчИЙ/)    
    IiFamEnd  = 'ИЙ ОЙ ЫЙ'  && ГорькИЙ (ЖириновскИЙ), ДонскОЙ (МеньшОЙ, РябОЙ), ПоперечнЫЙ (СытЫЙ)    
  * Список окончаний женских славянских фамилий    
    WmnFamEnd = 'АЯ ВА НА'  && ПодольскАЯ, РубиноВА, КлепиниНА    
  * СПИСОК N 1 ИНОСТРАННЫХ ФАМИЛИЙ, ОКАНЧИВАЮЩИХСЯ НА СОГЛАСНЫЙ ЗВУК, ДОПОЛНЯЮЩИХСЯ БУКВОЙ "У" У МУЖЧИН    
  * БессарАБ,КостопрАВ,КимчАГ,ТихолАЗ,СобчАК(КолчАК,ПастернАК),ХейердАЛ,КипермАН(НеждАН),НовАР,НикитАС,БАХ,КАЦ,    
  * ВагнЕР(ГомЕР),СервантЕС,АврЕХ,СаркИЗ,ТютюннИК(ТаможеннИК),КИМ,ЭдИП,СабонИС,СмИТ,ЛифшИЦ,МаслиевИЧ,ЭЙН,ВоЛК,МаксвеЛЛ,    
  * БраМС,ЛантиНГ,ГельфаНД,СаркисьяНЦ,МорОЗ,НиксОН(КлинтОН),РуссОС,кОХ,РезерфоРД,ОленбеРГ,НаймаРК,ЭйнгоРН,ПреСС,ЭрнСТ,МокрозУБ,    
  * ЦингаУЗ,ШевчУК,СтУЛ,ЦикУН,МацкявичУС,БУШ,ЛинколЬН,ТизенголЬТ,ПелЬШ,БаландЮК,КЮН,ТретьЯК,ШамоЯН,МотЯС (пока 54 штуки)    
    Jud1FamEnd = 'АБ АВ АГ АЗ АК АЛ АН АР АС АХ АЦ ЕР ЕС ЕХ ИЗ ИК ИМ ИП ИС ИТ ИЦ ИЧ ЙН ЛК ЛЛ МС НГ НД НЦ ' +;    
    			 'ОЗ ОН ОС ОХ РД РГ РК РН СС СТ УБ УЗ УК УЛ УН УС УШ ЬН ЬТ ЬШ ЮК ЮН ЯК ЯН ЯС'    
  * СПИСОК СКЛОНЯЕМЫХ НЕ РУССКИХ ФАМИЛИЙ N 2, заканчивающихся на гласные звуки А->Е и Я->Е, с предшествующей согласной    
  * за исключением указанных ниже несклоняемых фамилий французского происхождения. Например:    
  * ДзюБА,ГулыГА(МаГА,искл.ДеГА),НегоДА,ДюДЯ,ГамалЕЯ,ГлинКА(ДейнеКА,искл.ЛюКА),ИгЛА,,ЗозуЛЯ,КайМА(КарМА),КуралеНЯ,    
  * МазеПА(искл.ПетиПА),ГализдРА(искл.ГамарРА),ОпРЯ,ТупоТА,ВаренуХА,ЛисиЦА,ОлеША    
    Jud2FamEnd = 'БА ГА ДА ДЯ ЕЯ КА ЛА ЛЯ МА НЯ ПА РА РЯ ТА ХА ЦА ША'  && ... все на "А" и "Я" (здесь можно не пополнять)    
  * СПИСОК НЕ РУССКИХ ФАМИЛИЙ N 3 (фамилии, заканчивающиеся на "А[Й]"->"Ю", "[Ь]"->"Ю" и "У[Й]"->"Ю" у мужчин)      
  * МаклАЙ,ЛебеДЬ,ДруЗЬ,КоваЛЬ(ВрубеЛЬ,ГогоЛЬ,РозентаЛЬ,ЧерчилЛЬ),ОболоНЬ,ХемингуЭЙ,ХалУЙ    
    Jud3FamEnd = 'АЙ ДЬ ЕЙ ЗЬ ЛЬ НЬ ЭЙ УЙ'  && ...  ЕЙ (кроме ВоробЕЙ, СоловЕЙ), а на "Ь" - любые (здесь можно не пополнять)    
  * Несклоняемые фамилии французского происхождения: ДеГА, ЛюКА, ДюМА (ТоМА, ФерМА), ПетиПА и ГамарРА и др.     
    FranceFam = 'ДЕГА ЛЮКА ДЮМА ТОМА ФЕРМА ПЕТИПА ГАМАРРА ЗОЛЯ ТРУАЙА' + Space(1)    
        
  * Для проведения анализа при склонении нам потребуются:    
    LstLtIma  = Upper(Right(Ima,1))  && Последняя буква имени    
    LstTwoIma = Upper(Right(Ima,2))  && Последние две буквы имени    
    LstLtFam  = Upper(Right(Fam,1))  && Последняя буква фамилии    
    LstTwoFam = Upper(Right(Fam,2))  && Последние две буквы фамилии    
    LstTwoOtc = Upper(Right(Otc,2))  && Последние две буквы отчества    
    Processed = 0  && Признак того, что фамилия и имя еще не обработаны    
    Sex = "?"  && Пол: "М" - мужской, "Ж" - женский, "?" - не определен достоверно.    
        
  * Синтаксический разбор мужских и женских отчеств    
  * И одновременная попытка определения пола человека    
  * Также однозначно просклоняем отчество. Здесь нет трудностей.    
    If LstTwoOtc=="ИЧ" &&Если отчество заканчивается на буквы "ИЧ"    
    	Otc = Proper(Otc)+"у"  && Upper(Left(Otc,1))+Lower(SubStr(Otc,2,Len(Otc)-1))+"у" (даже Савельичу!)    
    	Sex = "М"    
    EndIf    
    If Upper(Right(Otc,1))=="А" && Если отчество заканчивается на букву "А"    
    	Otc = Upper(Left(Otc,1))+Lower(SubStr(Otc,2,Len(Otc)-2))+"е"    
    	Sex = "Ж"    
    EndIf    
    If Sex=="?"    
   	* "оглы" (для мужчин) и "кызы" (для женщин) не склоняются и могут писаться    
   	* как через черточку, так и отдельно от первой части отчества (однозначно определяют пол),    
   	* то есть ФИО может состоять из 4 слов.    
    	If At("ОГЛЫ", Upper(lFIO))    
    		Sex = "М"    
    	Else    
    		If At("КЫЗЫ", Upper(lFIO))    
    			Sex = "Ж"    
    		EndIf    
    	EndIf    
    EndIf    
  * Кто знает как правильно обрабатывать "ОГЛЫ", допишите свой код здесь ...    
        
  * Синтаксический разбор мужских фамилий и имен    
  * Если фамилия заканчивается на "ЕВ","ЁВ","ИН","ОВ","ЫН","ИЙ","ОЙ","ЫЙ"    
    If At(LstTwoFam, ManFamEnd)<>0 OR At(LstTwoFam, IiFamEnd)<>0    
    	If Sex=="М"  && Если обрабатывается мужчина    
    		Processed = 1 && Признак того, что фамилия и имя уже обработаны    
   		* Обработка мужской фамилии, заканчавающихся на "Й" весьма разнообразен и полон исключений    
   		* ПодольскИЙ, ВИЙ, ОкИЙ, БокИЙ, ЭдипИЙ, ЛенскИЙ, ВислоБокИЙ, СинеокИЙ, ГлубокИЙ, ТолстОЙ, СытЫЙ, ВиднЫЙ    
    		If At(LstTwoFam, IiFamEnd)<>0    
   			* Подобрано эмпирически, что фамилии на "ИЙ" длиной от 1 до 6, должны склоняться как исключение "БокИЙ"    
   			* Причем не помогает анализ предшествующей гласной. Так [БокИЙ] -> [БокИЮ], но [ВислоБокИЙ] -> [ВислоБокОМУ]    
   			* Предполагаем, что короткой фамилии ЭнскИЙ не существует, иначе она будет у нас склоняться неверно!    
        
   			* ПРАВИЛО РУССКОГО ЯЗЫКА: Фамилии с формальным показателем (суффиксом) -ск- (ДостоевСКий) склоняются    
   			* в мужском и женском роде и во множественном числе как прилагательные.    
    			If (LstTwoFam == "ИЙ") AND Len(Fam) < 6  && ВИЙ, ОкИЙ, БокИЙ  ([ИЙ]->[ИЮ])    
    				Fam = Upper(Left(Fam,1))+Lower(SubStr(Fam,2,Len(Fam)-2))+"ю"    
    			Else    
   				* Необходимо обработать также случай [ИЙ]->[ЕМУ], помимо наиболее распространенного [ИЙ]->[ОМУ].    
   				* Например [ПодьячИЙ]->[ПодьячЕМУ], [ЛучшИЙ]->[ЛучшЕМУ], [СмотрящИЙ]->[СмотрящЕМУ]    
    				If At(Upper(SubStr(Fam,Len(Fam)-2,1)), Hissing)<>0    
    					Fam = Upper(Left(Fam,1))+Lower(SubStr(Fam,2,Len(Fam)-3))+"ему"    
    				Else    
    					Fam = Upper(Left(Fam,1))+Lower(SubStr(Fam,2,Len(Fam)-3))+"ому"    
    				EndIf    
    			EndIf    
    		Else  && Все типично русские мужские фамилии склоняются по этой строке:    
    			Fam = Proper(Fam)+"у"    
    		EndIf    
   		************************************    
   		* Процедура обработки мужского имени    
    		If At(LstLtIma, ManLstLt)<>0    
    			DO Case    
    				Case Upper(Ima) == "ЛЕВ"   && Если Лев, то "ЕВ"->"ЬВУ"    
    					Ima = Upper(Left(Ima,1))+"ьву"    
    				Case LstTwoIma == "ЕЛ"     && Если ПавЕЛ, то убираем коренную гласную "Е" ("ЕЛ"->"ЛУ")    
    					Ima = Upper(Left(Ima,1))+Lower(SubStr(Ima,2,Len(Ima)-3))+"лу"    
    				Otherwise    
    					Ima = Proper(Ima)+"у"  && Upper(Left(Ima,1))+Lower(SubStr(Ima,2,Len(Ima)-1))+"у" && ИваН    
    			EndCase    
    		Else    
    			DO Case    
    				Case (LstLtIma=="А") OR (LstLtIma=="Я")  && НикитА, КузьмА, ЛукА, ФомА, СаввА, ИлиЯ, ИльЯ    
    					Ima = Upper(Left(Ima,1))+Lower(SubStr(Ima,2,Len(Ima)-2))+"е"    
   				* АлексеЙ,АнатолиЙ,АндреЙ,АркадиЙ,АрсениЙ,АртемиЙ,ВалериЙ,ВасилиЙ,ВиталиЙ,ГеннадиЙ,ГеоргиЙ,ГригориЙ,ДмитриЙ,    
   				* ЕвгениЙ,ЗиновиЙ,ИннокентиЙ,ЛаврентиЙ,МатвеЙ,МефодиЙ,МоисеЙ,НиколаЙ,СергеЙ,ТимофеЙ,ФеодосиЙ,ЮлиЙ,ЮриЙ    
   				* ГаделЬ,ГэмилЬ,ДжалилЬ,РафаэлЬ,ИгорЬ,КамилЬ,НаилЬ,ЛазарЬ,РавилЬ,РаилЬ,РасилЬ,ФаилЬ,ХалилЬ,ШамилЬ,ЭмилЬ,ЯлилЬ,ЯмилЬ    
    				Case (LstLtIma=="Й") OR (LstLtIma=="Ь")    
    					Ima = Upper(Left(Ima,1))+Lower(SubStr(Ima,2,Len(Ima)-2))+"ю"    
    			EndCase    
    		EndIf    
   		************************************    
    	EndIf  && Sex=="М"    
    EndIf    
        
  * Синтаксический разбор женских фамилий и имен    
    If At(LstTwoFam, WmnFamEnd)<>0  && Если фамил. зак-тся на "АЯ","ВА","НА",проверим посл.букву имени    
    	If Sex=="Ж"  && Если обрабатывается женщина    
    		Processed = 1  && Признак того, что фамилия и имя уже обработаны    
   		* Обработка женской фамилии    
    		If LstTwoFam=="АЯ"  && Касат[АЯ->ОЙ], Гурцк[АЯ->ОЙ] но Лучш[АЯ->ЕЙ] и Цхак[АЯ->АЯ]    
   			* Необходимо обработать также случай [АЯ]->[ЕЙ], помимо наиболее распространенного [АЯ]->[ОЙ].    
   			* Например [ПодьячАЯ]->[ПодьячЕЙ], [ЛучшАЯ]->[ЛучшЕЙ], [СмотрящАЯ]->[СмотрящЕЙ]    
    			If At(Upper(SubStr(Fam,Len(Fam)-2,1)), Hissing)<>0    
    				Fam = Upper(Left(Fam,1))+Lower(SubStr(Fam,2,Len(Fam)-3))+"ей"    
    			Else    
    				If NOT(Upper(Right(Fam,4))=="АКАЯ")  && Грузинская фамилия типа "Цхакая"    
    					Fam = Upper(Left(Fam,1))+Lower(SubStr(Fam,2,Len(Fam)-3))+"ой"    
    				EndIf    
    			EndIf    
    		Else  && Самый массовый случай русских женских фамилий, например, КольцоВ[А->ОЙ]    
   			* Но сюда могут "закрасться" грузинские женские фамилии, типа "Окуджава", проверим дополнительно!    
    			If Upper(Right(Fam,3))=="АВА"    
    				Fam = Upper(Left(Fam,1))+Lower(SubStr(Fam,2,Len(Fam)-2))+"е"    
    			Else    
    				Fam = Upper(Left(Fam,1))+Lower(SubStr(Fam,2,Len(Fam)-2))+"ой"    
    			EndIf    
    		EndI    
   		*************************************************************    
   		* Процедура обработки женского склоняемого имени,    
   		* т.е. не такого как несклоняемые имена: Жаклин, Каринэ, Нелли и т.п.    
    		If At(LstLtIma, WmnLstLt)<>0  && Если имя зак-тся на "А","Я" или "Ь"    
    			If Upper(Right(Ima,2))=="ИЯ"  && Имя оканчивается на -ия,    
    				If Upper(Ima)=="ИЯ"    
   					* Мою супругу зовут "Ия" (в переводе с греч."Фиалка"). Это "особый" случай!    
    					Ima = "Ие"    
    				Else    
   					* Если имя не Ия, то -ия заменяется на -ии, например, [ЛилИЯ]->[ЛилИИ]    
    					Ima = Upper(Left(Ima,1))+Lower(SubStr(Ima,2,Len(Ima)-3))+"ии"    
    				EndIf    
    			Else    
    				If LstLtIma<>"Ь"  && СветланА, ДарьЯ    
    					Ima = Upper(Left(Ima,1))+Lower(SubStr(Ima,2,Len(Ima)-2))+"е"    
    				Else  && ЛюбовЬ, НинелЬ    
    					Ima = Upper(Left(Ima,1))+Lower(SubStr(Ima,2,Len(Ima)-2))+"и"    
    				EndIf    
    			EndIf    
    		EndIf    
   		*************************************************************    
    	EndIf  && Sex=="Ж"    
    EndIf    
        
  * Синтаксический разбор украинских и некоторых других фамилий и имен на 3-ем проходе    
    If Processed==0  && Если фамилия и имя еще не обработаны    
   	* Вполне достоверно утверждение с сайта community.livejournal.com,    
   	* что женские фамилии, оканчивающиеся на согласный звук и мягкий знак не склоняются, а фамилии,    
   	* оканчивающиеся на гласный звук склоняются не зависимо от пола, с учетом следующих двух правил:    
        
   	* ПРАВИЛО 1: Все фамилии, пишущиеся с е, э, и, ы, у, ю на конце, могут быть только несклоняемыми.    
   	* Таковы фамилии: ДоДЕ, МавроДИ(КеннеДИ,ГанДИ), АмаДУ, ОрджоникидЗЕ, ШабрИЕ, МеЙЕ, НасоновсКИ,    
   	* ЧаушесКУ, НобиЛЕ(КараджаЛЕ,ТарЛЕ), ЛюлЛИ(ШелЛИ,РуставеЛИ), НеедЛЫ, КаМЮ, АртмаНЕ,     
   	* АхвледиаНИ(МодильяНИ,ЧабукиаНИ), ЛаНУ, КорНЮ, НавОИ, ШОУ, ЛансеРЕ, ХараРИ(ГретРИ), НеРУ,    
   	* МегРЭ, МюсСЕ, ДебюсСИ(ГолсуорСИ), ГёТЕ(ОрбакайТЕ), ДжусойТЫ, МанЦУ, ГрамШИ, БоссЮЭ, ФурЬЕ,...    
        
   	* ПРАВИЛО 2: Все фамилии, оканчивающиеся на а, которому предшествуют гласные звуки (чаще всего у или и), несклоняемы:    
   	* Галуа, Моруа, Делакруа, Моравиа, Эриа, Эредиа, Гулиа.    
        
   	* ПРАВИЛО 3: Несклоняемы фамилии французского происхождения с ударением на конце: ЗоЛЯ, ТруаЙА.     
   	* Все прочие фамилии на "-я" склоняемы; таковы ГоловНЯ, ЗозуЛЯ, СырокомЛЯ, ГамалЕЯ, ГоЙЯ, ШенгелАЯ,    
   	* ДанелИЯ, БерИЯ, БакерИЯ, ИверИЯ.     
   	* Грузинские фамилии оказываются склоняемыми или несклоняемыми в зависимости от того, в каком виде    
   	* конкретная фамилия заимствована русским языком: фамилии на -ия склоняемы (Данелия), на -иа - несклоняемы (Гулиа).    
        
   	* Нерусский список N2 (Jud2FamEnd) фамилий, заканчивающихся на гласные звуки "А", "Я" с предшествующей согласной,    
   	* кроме исключений, состоящих из фамилий французского происхождения (FranceFam), таких как ФерМА и т.п.    
        
    	If ((LstLtFam=="А" AND LstTwoFam<>"ИА" AND LstTwoFam<>"УА") OR LstLtFam=="Я") AND ;    
    		LstLtFam<>"Е" AND LstLtFam<>"Э" AND LstLtFam<>"И" AND LstLtFam<>"Ы" AND LstLtFam<>"У" AND LstLtFam<>"Ю" AND ;    
    		At(Upper(Fam)+Space(1), FranceFam)=0    
        
    		If LstTwoFam=="ИЯ"  && Склоняем грузинские фамилии на "ИЯ". Нам это разрешает делать правило!    
    			Fam = Upper(Left(Fam,1))+Lower(SubStr(Fam,2,Len(Fam)-2))+"и"    
    		Else  && Склоняем остальные склоняемые фамилии, заканчивающиеся на гласную из списка Jud2FamEnd    
    			Fam = Upper(Left(Fam,1))+Lower(SubStr(Fam,2,Len(Fam)-2))+"е"    
    		EndIf    
    	EndIf    
    	DO Case    
    		Case Sex=="М"  && Обрабатываем мужчину    
    			&& Нерусский список N1 (Jud1FamEnd)    
    			If At(LstTwoFam, Jud1FamEnd)<>0    
    				Fam = Proper(Fam)+"у"  && Upper(Left(Fam,1))+Lower(SubStr(Fam,2,Len(Fam)-1))+"у"    
    			EndIf    
    			&& Нерусский список N3 (Jud3FamEnd)    
    			If Upper(Fam)=="СОЛОВЕЙ" OR Upper(Fam)=="ВОРОБЕЙ"  && СОЛОВЕЙ, ВОРОБЕЙ (исключение)    
    				Fam = Upper(Left(Fam,1))+Lower(SubStr(Fam,2,Len(Fam)-3))+"ью"    
    			Else    
    				&& Список Jud3FamEnd ++    
    				If LstTwoFam=="АЙ" OR LstTwoFam=="ЕЙ" OR LstTwoFam=="УЙ" OR LstTwoFam=="ЭЙ" OR LstLtFam=="Ь"    
    					Fam = Upper(Left(Fam,1))+Lower(SubStr(Fam,2,Len(Fam)-2))+"ю"    
    				EndIf    
    			EndIf    
    			If LstTwoFam=="ЕЦ"    
   			    * Необходимо определять согласная или гласная буква находится перед "ЕЦ"    
   			    * МогилеВец, БоРец, КоБец (подвид 1 с предшествующим согласным звуком) [ЕЦ]->[ЦУ],    
   			    * БОец, КоломИец (подвид 2 с предшествующим гласным звуком /Vowels/)   [ЕЦ]->[ЙЦУ]    
    				If At(Upper(SubStr(Fam,Len(Fam)-2,1)), Vowels)=0    
    					Fam = Upper(Left(Fam,1))+Lower(SubStr(Fam,2,Len(Fam)-3))+"цу"    
    				Else    
    					Fam = Upper(Left(Fam,1))+Lower(SubStr(Fam,2,Len(Fam)-3))+"йцу"    
    				EndIf    
    			EndIf    
   			* КлюченОК,КовалЕнОК,МАзОК,МазурЕнОК,МазУрОК,МакарЕнОК,МакеЕнОК,МалашОнОК,МаскОлОК [ОК->КУ]    
   			* БаЙрОК[+У],БайЧтОК[+У],БлОК[+У],КоЛеОК[+У],КоЛтОК[+У],КосТлОК[+У],МаЛоОК[+У],ТененШтОК[+У],ТеСмОК[+У]    
   			* КоРшОК (МакАшОК, МалАшОК, ТерЕшОК, ТимОшОК) [ОК->КУ] (перед ОК стоит шипящая Ш)    
    			If LstTwoFam=="ОК"    
   				* "ОК" склоняем только у мужчин. Могут быть 2 случая:    
   				* 1 случай: КлюченОК [ОК->КУ]    
   				* 2 случай: БлОК [ОК->ОКУ]    
   				* Подмеченная закономерность (попробуйте опровергнуть - вряд ли удастся!):    
   				* Если 3-я с конца буква фамилии на "ОК" есть буква "Ш" или 4-я с конца буква гласная, то [ОК->КУ]    
    				If Len(Fam)>3 AND (Upper(SubStr(Fam,Len(Fam)-3,1))=="Ш" OR ;    
    								   At(Upper(SubStr(Fam,Len(Fam)-4,1)), Vowels)<>0)    
    					Fam = Upper(Left(Fam,1))+Lower(SubStr(Fam,2,Len(Fam)-3))+"ку"    
    				Else  && [ОК->ОКУ]    
    					Fam = Proper(Fam)+"у"    
    				EndIf    
    			EndIf    
   			* "ЕК" склоняем только у мужчин.    
   			* ЗДЕСЬ МЕНЯ ТЕРЗАЮТ СИЛЬНЫЕ СОМНЕНИЯ, НО ВЕСЬМА ПОХОЖЕ НА ТО, ЧТО ВЕЗДЕ ДЕЛАТЬ НУЖНО ИМЕННО ТАК:    
   			* КраснОщЕК[+У],КрЯчЕК[+У]. (?) ВанИчЕК[+У],ВасИлЕК[+У],КрЮчЕК[+У],МалЫшЕК[+У] (?)    
    			If LstTwoFam=="ЕК"    
    				Fam = Proper(Fam)+"у"    
    			EndIf    
   			************************************    
   			* Процедура обработки мужского имени    
    			If At(LstLtIma, ManLstLt)<>0    
    				DO Case    
    					Case Upper(Ima) == "ЛЕВ"   && Если Лев, то "ЕВ"->"ЬВУ"    
    						Ima = Upper(Left(Ima,1))+"ьву"    
    					Case LstTwoIma == "ЕЛ"     && Если ПавЕЛ, то убираем коренную гласную "Е" ("ЕЛ"->"ЛУ")    
    						Ima = Upper(Left(Ima,1))+Lower(SubStr(Ima,2,Len(Ima)-3))+"лу"    
    					Otherwise    
    						Ima = Proper(Ima)+"у"  && Upper(Left(Ima,1))+Lower(SubStr(Ima,2,Len(Ima)-1))+"у" && ИваН    
    				EndCase    
    			Else    
    				DO Case    
    					Case (LstLtIma=="А") OR (LstLtIma=="Я")  && НикитА, КузьмА, ЛукА, СаввА, ИлиЯ, ИльЯ    
    						Ima = Upper(Left(Ima,1))+Lower(SubStr(Ima,2,Len(Ima)-2))+"е"    
   					* АлексеЙ,АнатолиЙ,АндреЙ,АркадиЙ,АрсениЙ,АртемиЙ,ВалериЙ,ВасилиЙ,ВиталиЙ,ГеннадиЙ,ГеоргиЙ,ГригориЙ,ДмитриЙ,    
   					* ЕвгениЙ,ЗиновиЙ,ИннокентиЙ,ЛаврентиЙ,МатвеЙ,МефодиЙ,МоисеЙ,НиколаЙ,СергеЙ,ТимофеЙ,ФеодосиЙ,ЮлиЙ,ЮриЙ    
   					* ГаделЬ,ГэмилЬ,ДжалилЬ,РафаэлЬ,ИгорЬ,КамилЬ,НаилЬ,ЛазарЬ,РавилЬ,РаилЬ,РасилЬ,ФаилЬ,ХалилЬ,ШамилЬ,ЭмилЬ,ЯлилЬ,ЯмилЬ    
    					Case (LstLtIma=="Й") OR (LstLtIma=="Ь")    
    						Ima = Upper(Left(Ima,1))+Lower(SubStr(Ima,2,Len(Ima)-2))+"ю"    
    				EndCase    
    			EndIf    
   			************************************    
    		Case Sex=="Ж"  && Обрабатываем женщину    
   			* Не русскую женскую фамилию склонять не надо    
   			*************************************************************    
   			* Процедура обработки женского склоняемого имени,    
   			* т.е. не такого как несклоняемые имена: Жаклин, Каринэ, Нелли и т.п.    
    			If At(LstLtIma, WmnLstLt)<>0  && Если имя зак-тся на "А","Я" или "Ь"    
    				If Upper(Right(Ima,2))=="ИЯ"  && Имя оканчивается на -ия (ЛилИЯ),    
    					If Upper(Ima)=="ИЯ"    
   						* Мою супругу зовут "Ия" (в переводе с греч."Фиалка"). Это "особый" случай!    
    						Ima = "Ие"    
    					Else    
   						* Если имя не Ия, то -ия заменяется на -ии, например, [ЛилИЯ]->[ЛилИИ]    
    						Ima = Upper(Left(Ima,1))+Lower(SubStr(Ima,2,Len(Ima)-3))+"ии"    
    					EndIf    
    				Else    
    					If LstLtIma<>"Ь"  && СветланА, ДарьЯ    
    						Ima = Upper(Left(Ima,1))+Lower(SubStr(Ima,2,Len(Ima)-2))+"е"    
    					Else  && ЛюбовЬ, НинелЬ    
    						Ima = Upper(Left(Ima,1))+Lower(SubStr(Ima,2,Len(Ima)-2))+"и"    
    					EndIf    
    				EndIf    
    			EndIf    
   			*************************************************************    
    	EndCase    
    EndIf  && Если фамилия и имя еще не обработаны    
        
  * Обработка фамилий пишущихся через дефис (Миклухо-Маклай, Кох-Татаренко, ...)    
    lDefisPos = At("-", Fam)    
    If lDefisPos > 1    
    	Fam = Left(Fam, lDefisPos) + ;    
    		  Upper(SubStr(Fam, lDefisPos+1,1)) + ;    
    		  Right(Fam, Len(Fam)-lDefisPos-1)    
    EndIf    
        
  * Формируем фамилию, имя и отчество в дательном падеже    
    Return AllT(Fam + Space(1) + Ima + Space(1) + Otc)    
      
  Внутри используется вызов функции AfterAtNum, возвращающей остаток строки после искомого вхождения подстроки, которая была в Clipper, но отсутствует в VFP. Я переписал ее для VFP и привожу ниже. В принципе, по желанию, ее можно заменить замечательными VFP-функциями GetWordCount и GetWordNum  
      
   * AFTERATNUM(,,<[nCounter]>,<[nIgnore]> --> cAfterString      
   * Возвращает остаток строки после искомого вхождения подстроки.      
   * cSearchFor - символьный параметр , задающий искомую подстроку.      
   * cString    - символьный параметр , задающий обрабатываемую подстроку.      
   * nCounter   - числовой параметр , задающий номер искомого вхождения cSearchFor в cString.      
   * nCounter=0 - осуществляется поиск последнего вхождения.      
   * nIgnore    - числовой параметр , задающий количество символов с начала строки cString,      
   *              исключаемых из поиска.      
   * nIgnore=0 при отсутствии исключения символов из поиска.      
            
      LPARAM cSearchFor, cString, nCounter, nIgnore      
      LOCAL cAfterString, ch, cw      
            
      if empty(nCounter)      
        nCounter = 0          && поиск последнего вхождения      
      endif      
            
      if empty(nIgnore)      
        nIgnore = 0           && отсутствие исключения символов из поиска      
      endif      
            
      ch = 0      
      if nIgnore<>0           && если не игнорировать первые символы      
        ch = 1      
        str = right(cString,len(cString)-nIgnore)      
      endif      
      if nCounter<>0          && если искать вхождение номер nCounter      
        do while nCounter<>0      
          cw = at(cSearchFor,cString)      
          ch = cw      
          nCounter = nCounter-1      
          if nCounter>0      
            ch = cw      
            cString = right(cString,len(cString)-len(cSearchFor)-ch+1)      
          endif      
        enddo      
        if ch<>0      
          cString = right(cString,len(cString)-len(cSearchFor)-ch+1)      
          cAfterString = cString      
        else      
          cString = ''      
          cAfterString = cString      
        endif      
      else                    && nCounter==0 - поиск последнего вхождения      
        cw = at(cSearchFor,cString)      
        ch = cw      
        if ch = 0      
          cString = ''      
        endif      
        do while ch<>0      
          cString = right(cString,len(cString)-len(cSearchFor)-ch+1)      
          cw = at(cSearchFor,cString)      
          ch = cw      
        enddo      
        cAfterString = cString      
      endif      
            
      Return cAfterString
Автор: rvc44

Автор публикации

не в сети 15 лет

rvc44

0
Комментарии: 0Публикации: 7Регистрация: 06-12-2005
0
Вложенные файлы
#
Тип файла
Размер
Название
1 .zip 8,56 КБ 571getdativ21
Оставить комментарий
Авторизация
*
*
Регистрация
*
*
*
Пароль не введен
*
Генерация пароля