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;

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.

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 : 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.: 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.