Сортировка вставками

program lab1;
type
    DataArray=array[1..5000] of string;
    DataK=array[1..5000] of integer;
var
    item: DataArray;{массив ключей, в качестве ключей служат слова из текста}
    k: DataK; {массив, хронящий информативную часть, порядковый номер в тексте}
    s:string; {временная переменная, предназначена для передачи в массив, или ссчитывания из него}
    ch,ch2:char;
    count,i,j,m:integer;
    fout:text;{файл для вывода объявляем текстовым, так как заносим в него строки}
    fin:file of char;{файл для ввода обявляем типизированным с типом char, чтобы процедура чтения read() получала по одному символу}
 
procedure Inser(var item: DataArray; var k: DataK; count:integer); {сортировка}
var
i, j, h: integer;
x: string;
begin
for i := 2 to count do
 begin
 x := item[i];
 h := k[i];
 j := i-1;
 while (x<item[j]) and (j>0) do
  begin
  item[j+1] := item[j];
  k[j+1] := k[j];
  j := j-1;
  end;
 item[j+1] := x;
 k[j+1]:= h;
 end;
end;    
 
procedure Convert(var s:string); {ANSI -> ASCII}
var i:integer;
begin
for i:=1 to length(s) do
if ord(s[i]) in [192..207] then s[i]:=chr(ord(s[i])-32) {Буквы: А..П переводим в ASCII-код меняя на: а..п}
else if ord(s[i]) in [208..223] then s[i]:=chr(ord(s[i])+16) {Буквы: Р..Я переводим в ASCII-код меняя на: р..я}
else if ord(s[i]) in [224..239] then s[i]:=chr(ord(s[i])-64) {Буквы: а..п переводим в ASCII-код }
else if ord(s[i]) in [240..255] then s[i]:=chr(ord(s[i])-16) {Буквы: р..я переводим в ASCII-код }
else if ord(s[i])=168 then s[i]:=chr(ord(241)) {Букву Ё переводим в ASCII-код и меняем на: ё}
else if ord(s[i])=184 then s[i]:=chr(ord(241)); {Букву ё переводим в ASCII-код}
end;
 
procedure UnConvert(var a:string);{ASCII->ANSI}
var i:integer;
begin
for i:=1 to length(a) do
if ord(a[i]) in [128..175] then a[i]:=chr(ord(a[i])+64)
else if ord(a[i]) in [224..239] then a[i]:=chr(ord(a[i])+16)
else if ord(a[i])=240 then a[i]:=chr(ord(168))
else if ord(a[i])=241 then a[i]:=chr(ord(184));
end;
 
{начало основной программы}
begin
Assign(fin,'text1.txt'); {ставим в соответствие файловым переменным имена файлов}
Assign(fout,'text2.txt');
Reset(fin); {открываем fin для чтения, а fout для записи}
Rewrite(fout);
i:=1;
repeat {общий цикл, работает пока не дойдем до конца файла}
 
 s:='';{очищаем переменную строки, для записи нового слова}
    repeat
    read(fin,ch);{cчитываем символ из файла}
    if (ch<>'.') and (ord(ch)<>32) and (ch<>',') and (ord(ch)<>45) and (ch<>'"') and (ch<>'?') and (ch<>'!') and (ch<>':') and (ord(ch)<>10) then s:=s+ch;
    until (ord(ch)=32) or (ord(ch)=10) or (ord(ch)=45) or (EOF(fin));
 if s<>'' then
  begin
  Convert(s);
  item[i]:=s;
  k[i]:=i;
  count:=i;
  i:=i+1;
  end;
until EOF(fin);{если достигнут конец файла - выходим}
 
Inser(item,k,count);
for i:=1 to count do
 begin
  s:=item[i];
  m:=k[i];
  UnConvert(s);
  write(fout, m,' '+s+chr(10));
 end;
 
Close(fout);{закрываем оба файла}
Close(fin);
end.