// Файл 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(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] = 'Е' 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;

// Файл NtxAdd.pas

unit NtxAdd;

interface

uses classes, SysUtils, NtxRO;

type

 TNtxAdd = class(TNtxRO)
 protected
 function Changed: boolean; override;
 function Add(var s: ShortString; var rn: integer; var nxt: integer):
 boolean;
 procedure NewRoot(s: ShortString; rn: integer; nxt: integer); virtual;
 function GetFreePtr(p: PBuf): Word;
 public
 constructor Create(nm: ShortString; ks: Word);
 constructor Open(nm: ShortString);
 procedure Insert(key: ShortString; rn: integer);
 end;

implementation

function TNtxAdd.GetFreePtr(p: PBuf): Word;
var
 i, j: integer;

 r: Word;
 fl: boolean;
begin

 r := (max + 2) * 2;
 for i := 1 to max + 1 do
 begin
 fl := True;
 for j := 1 to GetCount(p) + 1 do
 if GetCount(PBuf(@(p^[j * 2]))) = r then
 fl := False;
 if fl then
 begin
 Result := r;
 exit;
 end;
 r := r + isz;
 end;
 Result := 0;
end;

function TNtxAdd.Add(var s: ShortString; var rn: integer; var nxt: integer):
 boolean;
var
 p: PBuf;

 w, fr: Word;
 i: integer;
 tmp: integer;
begin

 with tr do
 begin
 p := GetPage(h, (TTraceRec(Items[Count - 1])).pg);
 if GetCount(p) then
 begin
 fr := GetFreePtr(p);
 if fr = 0 then
 begin
 Self.Error := True;
 Result := True;
 exit;
 end;
 w := GetCount(p) + 1;
 p^[0] := w and $FF;
 p^[1] := (w and $FF00) shr 8;
 w := (TTraceRec(Items[Count - 1])).cn;
 for i := GetCount(p) + 1 downto w + 1 do
 begin
 p^[2 * i] := p^[2 * i - 2];
 p^[2 * i + 1] := p^[2 * i - 1];
 end;
 p^[2 * w] := fr and $FF;
 p^[2 * w + 1] := (fr and $FF00) shr 8;
 for i := 0 to length(s) - 1 do
 p^[fr + 8 + i] := ord(s[i + 1]);
 for i := 0 to 3 do
 begin
 p^[fr + i] := nxt mod $100;
 nxt := nxt div $100;
 end;
 for i := 0 to 3 do
 begin
 p^[fr + i + 4] := rn mod $100;
 rn := rn div $100;
 end;
 FileSeek(h, (TTraceRec(Items[Count - 1])).pg, 0);
 FileWrite(h, p^, 1024);
 Result := True;
 end
 else
 begin
 fr := GetCount(p) + 1;
 fr := GetCount(PBuf(@(p^[fr * 2])));
 w := (TTraceRec(Items[Count - 1])).cn;
 for i := GetCount(p) + 1 downto w + 1 do
 begin
 p^[2 * i] := p^[2 * i - 2];
 p^[2 * i + 1] := p^[2 * i - 1];
 end;
 p^[2 * w] := fr and $FF;
 p^[2 * w + 1] := (fr and $FF00) shr 8;
 for i := 0 to length(s) - 1 do
 p^[fr + 8 + i] := ord(s[i + 1]);
 for i := 0 to 3 do
 begin
 p^[fr + i + 4] := rn mod $100;
 rn := rn div $100;
 end;
 tmp := 0;
 for i := 3 downto 0 do
 tmp := $100 * tmp + p^[fr + i];
 for i := 0 to 3 do
 begin
 p^[fr + i] := nxt mod $100;
 nxt := nxt div $100;
 end;
 w := hlf;
 p^[0] := w and $FF;
 p^[1] := (w and $FF00) shr 8;
 fr := GetCount(PBuf(@(p^[(hlf + 1) * 2])));
 s := '';
 rn := 0;
 for i := 0 to ksz - 1 do
 begin
 s := s + chr(p^[fr + 8 + i]);
 p^[fr + 8 + i] := 0;
 end;
 for i := 3 downto 0 do
 begin
 rn := $100 * rn + p^[fr + i + 4];
 p^[fr + i + 4] := 0;
 end;
 nxt := FileSeek(h, 0, 2);
 FileWrite(h, p^, 1024);
 for i := 1 to hlf do
 begin
 p^[2 * i] := p^[2 * (i + hlf + 1)];
 p^[2 * i + 1] := p^[2 * (i + hlf + 1) + 1];
 end;
 for i := 0 to 3 do
 begin
 p^[fr + i] := tmp mod $100;
 tmp := tmp div $100;
 end;
 FileSeek(h, (TTraceRec(Items[Count - 1])).pg, 0);
 FileWrite(h, p^, 1024);
 Result := False;
 end;
 end;
end;

procedure TNtxAdd.NewRoot(s: ShortString; rn: integer; nxt: integer);
var
 p: PBuf;

 i, fr: integer;
begin

 p := GetPage(h, 0);
 for i := 0 to 1023 do
 p^[i] := 0;
 fr := (max + 2) * 2;
 p^[0] := 1;
 p^[2] := fr and $FF;
 p^[3] := (fr and $FF00) shr 8;
 for i := 0 to length(s) - 1 do
 p^[fr + 8 + i] := ord(s[i + 1]);
 for i := 0 to 3 do
 begin
 p^[fr + i] := nxt mod $100;
 nxt := nxt div $100;
 end;
 for i := 0 to 3 do
 begin
 p^[fr + i + 4] := rn mod $100;
 rn := rn div $100;
 end;
 fr := fr + isz;
 p^[4] := fr and $FF;
 p^[5] := (fr and $FF00) shr 8;
 nxt := GetRoot;
 for i := 0 to 3 do
 begin
 p^[fr + i] := nxt mod $100;
 nxt := nxt div $100;
 end;
 nxt := FileSeek(h, 0, 2);
 FileWrite(h, p^, 1024);
 FileSeek(h, 4, 0);
 FileWrite(h, nxt, sizeof(integer));
end;

procedure TNtxAdd.Insert(key: ShortString; rn: integer);
var
 nxt: integer;

 i: integer;
begin
 nxt := 0;
 if DosFl then
 key := WinToDos(key);
 if length(key) > ksz then
 key := Copy(key, 1, ksz);
 for i := 1 to ksz - length(key) do
 key := key + ' ';
 Clear;
 Load(GetRoot);
 Seek(key, False);
 while True do
 begin
 if Add(key, rn, nxt) then
 break;
 if tr.Count = 1 then
 begin
 NewRoot(key, rn, nxt);
 break;
 end;
 Pop;
 end;
end;

constructor TNtxAdd.Create(nm: ShortString; ks: Word);
var
 p: PBuf;

 i: integer;
begin

 Error := False;
 DeleteFile(nm);
 h := FileCreate(nm);
 if h > 0 then
 begin
 p := GetPage(h, 0);
 for i := 0 to 1023 do
 p^[i] := 0;
 p^[14] := ks and $FF;
 p^[15] := (ks and $FF00) shr 8;
 ks := ks + 8;
 p^[12] := ks and $FF;
 p^[13] := (ks and $FF00) shr 8;
 i := (1020 - ks) div (2 + ks);
 i := i div 2;
 p^[20] := i and $FF;
 p^[21] := (i and $FF00) shr 8;
 i := i * 2;
 max := i;
 p^[18] := i and $FF;
 p^[19] := (i and $FF00) shr 8;
 i := 1024;
 p^[4] := i and $FF;
 p^[5] := (i and $FF00) shr 8;
 FileWrite(h, p^, 1024);
 for i := 0 to 1023 do
 p^[i] := 0;
 i := (max + 2) * 2;
 p^[2] := i and $FF;
 p^[3] := (i and $FF00) shr 8;
 FileWrite(h, p^, 1024);
 end
 else
 Error := True;
 FileClose(h);
 FreeHandle(h);
 Open(nm);
end;

constructor TNtxAdd.Open(nm: ShortString);
begin

 Error := False;
 h := FileOpen(nm, fmOpenReadWrite or fmShareExclusive);
 if h > 0 then
 begin
 FileSeek(h, 12, 0);
 FileRead(h, isz, 2);
 FileSeek(h, 14, 0);
 FileRead(h, ksz, 2);
 FileSeek(h, 18, 0);
 FileRead(h, max, 2);
 FileSeek(h, 20, 0);
 FileRead(h, hlf, 2);
 DosFl := True;
 tr := TList.Create;
 end
 else
 Error := True;
end;

function TNtxAdd.Changed: boolean;
begin

 Result := (csize = 0);
 csize := -1;
end;

end.

// Файл NtxRO.pas

unit NtxRO;

interface

uses Classes;

type
 TBuf = array[0..1023] of Byte;

 PBuf = ^TBuf;
 TTraceRec = class
 public
 pg: integer;
 cn: SmallInt;
 constructor Create(p: integer; c: SmallInt);
 end;
 TNtxRO = class
 protected
 fs: string[10];
 empty: integer;
 csize: integer;
 rc: integer; {Текущий номер записи}
 tr: TList; {Стек загруженных страниц}
 h: integer; {Дескриптор файла}
 isz: Word; {Размер элемента}
 ksz: Word; {Размер ключа}
 max: Word; {Максимальное кол-во элементов}
 hlf: Word; {Половина страницы}
 function GetRoot: integer; {Указатель на корень}
 function GetEmpty: integer; {Пустая страница}
 function GetSize: integer; {Возвращает размер файла}
 function GetCount(p: PBuf): Word; {Число элементов на странице}
 function Changed: boolean; virtual;
 procedure Clear;
 function Load(n: integer): PBuf;
 function Pop: PBuf;
 function Seek(const s: ShortString; fl: boolean): boolean;
 function Skip: PBuf;
 function GetItem(p: PBuf): PBuf;
 function GetLink(p: PBuf): integer;
 public
 Error: boolean;
 DosFl: boolean;
 constructor Open(nm: ShortString);
 destructor Destroy; override;
 function Find(const s: ShortString): boolean;
 function GetString(p: PBuf; c: SmallInt): ShortString;
 function GetRecN(p: PBuf): integer;
 function Next: PBuf;
 end;

function GetPage(h, fs: integer): PBuf;
procedure FreeHandle(h: integer);
function DosToWin(const ss: ShortString): ShortString;
function WinToDos(const ss: ShortString): ShortString;

implementation

uses Windows, SysUtils;

const
 MaxPgs = 5;
var
 Buf: array[1..1024 * MaxPgs] of char;

 Cache: array[1..MaxPgs] of record
 Handle: integer; {0-страница свободна}
 Offset: integer; { смещение в файле}
 Countr: integer; { счетчик использования}
 Length: SmallInt;
 end;

function TNtxRO.Next: PBuf;
var
 cr: integer;

 p: PBuf;
begin

 if h <= 0 then
 begin
 Result := nil;
 exit;
 end;
 while Changed do
 begin
 cr := rc;
 Find(fs);
 while cr > 0 do
 begin
 p := Skip;
 if GetRecN(p) = cr then
 break;
 end;
 end;
 Result := Skip;
end;

function TNtxRO.Skip: PBuf;
var
 cnt: boolean;

 p, r: PBuf;
 n: integer;
begin
 r := nil;

 cnt := True;
 with tr do
 begin
 p := GetPage(h, (TTraceRec(Items[Count - 1])).pg);
 while cnt do
 begin
 cnt := False;
 if (TTraceRec(Items[Count - 1])).cn > GetCount(p) + 1 then
 begin
 if Count <= 1 then
 begin
 Result := nil;
 exit;
 end;
 p := Pop;
 end
 else
 while True do
 begin
 r := GetItem(p);
 n := GetLink(r);
 if n = 0 then
 break;
 p := Load(n);
 end;
 if (TTraceRec(Items[Count - 1])).cn >= GetCount(p) + 1 then
 cnt := True
 else
 r := GetItem(p);
 Inc((TTraceRec(Items[Count - 1])).cn);
 end;
 end;
 if r <> nil then
 begin
 rc := GetRecN(r);
 fs := GetString(r, length(fs));
 end;
 Result := r;
end;

function TNtxRO.GetItem(p: PBuf): PBuf;
var
 r: PBuf;
begin

 with TTraceRec(tr.items[tr.Count - 1]) do
 r := PBuf(@(p^[cn * 2]));
 r := PBuf(@(p^[GetCount(r)]));
 Result := r;
end;

function TNtxRO.GetString(p: PBuf; c: SmallInt): ShortString;
var
 i: integer;

 r: ShortString;
begin
 r := '';

 if c = 0 then
 c := ksz;
 for i := 0 to c - 1 do
 r := r + chr(p^[8 + i]);
 if DosFl then
 r := DosToWin(r);
 Result := r;
end;

function TNtxRO.GetLink(p: PBuf): integer;
var
 i, r: integer;
begin
 r := 0;

 for i := 3 downto 0 do
 r := r * 256 + p^[i];
 Result := r;
end;

function TNtxRO.GetRecN(p: PBuf): integer;
var
 i, r: integer;
begin
 r := 0;

 for i := 3 downto 0 do
 r := r * 256 + p^[i + 4];
 Result := r;
end;

function TNtxRO.GetCount(p: PBuf): Word;
begin

 Result := p^[1] * 256 + p^[0];
end;

function TNtxRO.Seek(const s: ShortString; fl: boolean): boolean;
var
 r: boolean;

 p, q: PBuf;
 nx: integer;
begin
 r := False;

 with TTraceRec(tr.items[tr.Count - 1]) do
 begin
 p := GetPage(h, pg);
 while cn <= GetCount(p) + 1 do
 begin
 q := GetItem(p);
 if (cn > GetCount(p)) or (s < GetString(q, length(s))) or
 (fl and (s = GetString(q, length(s)))) then
 begin
 nx := GetLink(q);
 if nx <> 0 then
 begin
 Load(nx);
 r := Seek(s, fl);
 end;
 Result := r or (s = GetString(q, length(s)));
 exit;
 end;
 Inc(cn);
 end;
 end;
 Result := False;
end;

function TNtxRO.Find(const s: ShortString): boolean;
var
 r: boolean;
begin

 if h <= 0 then
 begin
 Result := False;
 exit;
 end;
 rc := 0;
 csize := 0;
 r := False;
 while Changed do
 begin
 Clear;
 Load(GetRoot);
 if length(s) > 10 then
 fs := Copy(s, 1, 10)
 else
 fs := s;
 R := Seek(s, True);
 end;
 Result := r;
end;

function TNtxRO.Load(N: integer): PBuf;
var
 it: TTraceRec;

 r: PBuf;
begin
 r := nil;

 if h > 0 then
 begin
 with tr do
 begin
 it := TTraceRec.Create(N, 1);
 Add(it);
 end;
 r := GetPage(h, N);
 end;
 Result := r;
end;

procedure TNtxRO.Clear;
var
 it: TTraceRec;
begin

 while tr.Count > 0 do
 begin
 it := TTraceRec(tr.Items[0]);
 tr.Delete(0);
 it.Free;
 end;
end;

function TNtxRO.Pop: PBuf;
var
 r: PBuf;

 it: TTraceRec;
begin
 r := nil;

 with tr do
 if Count > 1 then
 begin
 it := TTraceRec(Items[Count - 1]);
 Delete(Count - 1);
 it.Free;
 it := TTraceRec(Items[Count - 1]);
 r := GetPage(h, it.pg)
 end;
 Result := r;
end;

function TNtxRO.Changed: boolean;
var
 i: integer;

 r: boolean;
begin
 r := False;

 if h > 0 then
 begin
 i := GetEmpty;
 if i <> empty then
 r := True;
 empty := i;
 i := GetSize;
 if i <> csize then
 r := True;
 csize := i;
 end;
 Result := r;
end;

constructor TNtxRO.Open(nm: ShortString);
begin

 Error := False;
 h := FileOpen(nm, fmOpenRead or fmShareDenyNone);
 if h > 0 then
 begin
 fs := '';
 FileSeek(h, 12, 0);
 FileRead(h, isz, 2);
 FileSeek(h, 14, 0);
 FileRead(h, ksz, 2);
 FileSeek(h, 18, 0);
 FileRead(h, max, 2);
 FileSeek(h, 20, 0);
 FileRead(h, hlf, 2);
 empty := -1;
 csize := -1;
 DosFl := True;
 tr := TList.Create;
 end
 else
 Error := True;
end;

destructor TNtxRO.Destroy;
begin

 if h > 0 then
 begin
 FileClose(h);
 Clear;
 tr.Free;
 FreeHandle(h);
 end;
 inherited Destroy;
end;

function TNtxRO.GetRoot: integer;
var
 r: integer;
begin
 r := -1;

 if h > 0 then
 begin
 FileSeek(h, 4, 0);
 FileRead(h, r, 4);
 end;
 Result := r;
end;

function TNtxRO.GetEmpty: integer;
var
 r: integer;
begin
 r := -1;

 if h > 0 then
 begin
 FileSeek(h, 8, 0);
 FileRead(h, r, 4);
 end;
 Result := r;
end;

function TNtxRO.GetSize: integer;
var
 r: integer;
begin
 r := 0;

 if h > 0 then
 r := FileSeek(h, 0, 2);
 Result := r;
end;

constructor TTraceRec.Create(p: integer; c: SmallInt);
begin

 pg := p;
 cn := c;
end;

function GetPage(h, fs: integer): PBuf; {Протестировать отдельно}
var
 i, j, mn: integer;

 q: PBuf;
begin

 mn := 10000;
 j := 0;
 for i := 1 to MaxPgs do
 if (Cache[i].Handle = h) and
 (Cache[i].Offset = fs) then
 begin
 j := i;
 if Cache[i].Countr < 10000 then
 Inc(Cache[i].Countr);
 end;
 if j = 0 then
 begin
 for i := 1 to MaxPgs do
 if Cache[i].Handle = 0 then
 j := i;
 if j = 0 then
 for i := 1 to MaxPgs do
 if Cache[i].Countr <= mn then
 begin
 mn := Cache[i].Countr;
 j := i;
 end;
 Cache[j].Countr := 0;
 mn := 0;
 end;
 q := PBuf(@(Buf[(j - 1) * 1024 + 1]));
 if mn = 0 then
 begin
 FileSeek(h, fs, 0);
 Cache[j].Length := FileRead(h, q^, 1024);
 end;
 Cache[j].Handle := h;
 Cache[j].Offset := fs;
 Result := q;
end;

procedure FreeHandle(h: integer);
var
 i: integer;
begin

 for i := 1 to MaxPgs do
 if Cache[i].Handle = h then
 Cache[i].Handle := 0;
end;

function DosToWin(const ss: ShortString): ShortString;
var
 r: ShortString;

 i: integer;
begin
 r := '';

 for i := 1 to length(ss) do
 if ss[i] in [chr($80)..chr($9F)] then
 r := r + chr(ord(ss[i]) - $80 + $C0)
 else if ss[i] in [chr($A0)..chr($AF)] then
 r := r + chr(ord(ss[i]) - $A0 + $C0)
 else if ss[i] in [chr($E0)..chr($EF)] then
 r := r + chr(ord(ss[i]) - $E0 + $D0)
 else if ss[i] in [chr($61)..chr($7A)] then
 r := r + chr(ord(ss[i]) - $61 + $41)
 else if ss[i] in [chr($F0)..chr($F1)] then
 r := r + chr($C5)
 else
 r := r + ss[i];
 Result := r;
end;

function WinToDos(const ss: ShortString): ShortString;
var
 r: ShortString;

 i: integer;
begin
 r := '';

 for i := 1 to length(ss) do
 if ss[i] in [chr($C0)..chr($DF)] then
 r := r + chr(ord(ss[i]) - $C0 + $80)
 else if ss[i] in [chr($E0)..chr($FF)] then
 r := r + chr(ord(ss[i]) - $E0 + $80)
 else if ss[i] in [chr($F0)..chr($FF)] then
 r := r + chr(ord(ss[i]) - $F0 + $90)
 else if ss[i] in [chr($61)..chr($7A)] then
 r := r + chr(ord(ss[i]) - $61 + $41)
 else if ss[i] in [chr($D5), chr($C5)] then
 r := r + chr($F0)
 else
 r := r + ss[i];
 Result := r;
end;

end.