// Файл 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.