uses crt;
const
  cycle:array[1..11] of string=('do','downto','else','for','if','in','repeat','then','to','until','while');
  base:array[1..12] of string=('begin','else','end','function','goto','label','not','or','procedure','program','uses','var');
  spec1:array[1..8] of string=('and','asm','constructor','destructor','external','forward','implementation','inline');
  spec2:array[1..7] of string=('interface','interrupt','nil','object','shl','shr','packed');
  types:array[1..9] of string=('array','case','const','file','record','set','string','type','unit');
  math:array[1..6] of string=('div','mod','of','or','with','xor');
  direct:array[1..6] of string=('absolute','assembler','far','near','private','virtual');
  symbols:array[1..14] of char=('{','}','(',')','=',' ',';',':','+','-','/','*','.',',');
var
  f,f_new:text;
  s,s1:string;
  i:byte;
  kol:byte;
  mas:array[1..59] of string;
  mas2:array[1..59] of byte;
  temp:array[1..59] of string;

procedure massiv(cycle,base,spec1,spec2,types,math,direct:array of string);
var mas2:array [1..59] of byte;
    begin
    for i:=1 to 59 do
     temp[i]:='';
    for i:=1 to 11 do
     mas[i]:=cycle[i];
     for i:=11 to 23 do
     mas[i]:=base[i];
     for i:=23 to 31 do
     mas[i]:=spec1[i];
     for i:=31 to 38 do
     mas[i]:=spec2[i];
     for i:=38 to 47 do
     mas[i]:=types[i];
     for i:=47 to 53 do
     mas[i]:=math[i];
     for i:=53 to 59 do
     mas[i]:=direct[i];
    for i:=1 to 59 do
    mas2[i]:=kol;
end;

begin
clrscr;
  writeln('Vvedite imya faila: ');
  readln(s);
  assign(f,s);
  {$I-} reset(f); {$I+}
   if ioresult<>0 then writeln('Cannot open file to read!');
  writeln('Vvedite imya novogo faila: ');
  readln(s1);
  assign(f_new,s1);
  {$I-} rewrite(f_new); {$I+}
   if ioresult<>0 then writeln('Cannot create file to input!');
   massiv(cycle,base,spec1,spec2,types,math,direct);
   s:=''; s1:='';
   i:=0; kol:=0;
  while not seekeof(f) do begin
 readln(f,s);
 massiv(cycle,base,spec1,spec2,types,math,direct);
  if s=symbols[i]+mas[i]+symbols[i] then begin
     mas2[i]:=kol+1;
     writeln('slovo' ,mas[i],' vstrechaetsia ',mas2[i],' raz');
     end;
  end;
readln;
end.

const
 base:array[1..12] of string=('begin','else','end','function','goto','label','not',
'or','procedure','program','uses','var');
 spec1:array[1..8] of string=('and','asm','constructor','destructor','external',
'forward','implementation','inline');
...
procedure massiv(cycle,base,spec1,spec2,types,math,direct:array of string);
...
begin
...
for i:=11 to 23 do
  mas[i]:=base[i]; { а что, в Base имеется элемент с индексом > 12 ??? } 
for i:=23 to 31 do
  mas[i]:=spec1[i]; { а в Spec1 - с индексом > 8 ??? }
...
{ и так далее... }
end;

var
 zar:array[1..51] of string[15];

function progwork(s:string):string;
var
 i:integer;  n:byte;
begin
 for i:=1 to 51 do  if pos(zar[i],s)<>0 then begin
  n:=pos(zar[i],s);
  s[n]:= upcase(s[n]);
 end;
 progwork:=s;
end;

var
 f,f1:text; s:string;
begin
 zar[1]:='and'; zar[2]:='asm';zar[3]:= 'array';zar[4]:= 'begin';zar[5]:= 'case';
 zar[6]:= 'const';zar[7]:= 'constructor';zar[8]:= 'destructor';zar[9]:= 'div';zar[10]:= 'do';
 zar[11]:= 'downto';zar[12]:= 'else';zar[13]:= 'end';zar[14]:= 'exports';zar[15]:= 'file';
 zar[16]:= 'for';zar[17]:= 'function';zar[18]:= 'goto';zar[19]:= 'if';zar[20]:= 'implementation';
 zar[21]:= 'in';zar[22]:= 'inherited';zar[23]:= 'inline';zar[24]:= 'interface';
 zar[25]:= 'label';zar[26]:= 'library';zar[27]:= 'mod';zar[28]:= 'nil';zar[29]:= 'not';
 zar[30]:= 'object';zar[31]:= 'of';zar[32]:= 'or';zar[33]:= 'packed';zar[34]:= 'procedure';
 zar[35]:= 'program';zar[36]:= 'record';zar[37]:= 'repeat';zar[38]:= 'set';zar[39]:= 'shl';
 zar[40]:= 'shr';zar[41]:= 'string';zar[42]:= 'then';zar[43]:= 'to';zar[44]:= 'type';zar[45]:= 'unit';
 zar[46]:= 'until';zar[47]:= 'uses';zar[48]:= 'var';zar[49]:= 'while';zar[50]:= 'with';zar[51]:= 'xor';
 readln(s);
 assign(f,s);
 assign(f1,'D:\temp1.pas');
 {$i-}reset(f);{$i+}
 If IOresult<>0 then begin writeln('error'); readln; halt; end;
 rewrite(f1);
 repeat
  readln(f,s);
  writeln(f1,progwork(s));
 until eof(f);
 close(F); close(f1);
end.

function is_letter(ch: char): boolean;
begin
  is_letter := ch in ['a'..'z', 'A'..'Z', '_'];
end;
function progwork(s:string):string;
var
  i:integer;
  prev_n, n:byte;
  before, after: integer;
begin
  for i:=1 to 51 do begin
    prev_n := 0;
    repeat

      n := pos(zar[i], s);
      if prev_n = n then break;
      before := n - 1;
      after := n + length(zar[i]);

      if n <> 0 then begin
        if ( (before >= 1) and is_letter(s[before]) ) or
           ( (after <= length(s)) and is_letter(s[after]) ) then
        else s[n]:= upcase(s[n]);
      end;
      prev_n := n

    until n = 0;
  end;

  progwork:=s;
end;

 for i:=1 to 51 do
    kolvo[i]:=kol;

{ СТОП !!! Дальше можешь не ходить }
{ Значение i после выхода из цикла НЕ ОПРЕДЕЛЕНО }

while not seekeof(f) do begin
    readln(f,s);
    n:=length(s);
    t:=n-(n+1);
    if s=slovo[i] then begin
       if (s[t]=znak[i]) and (s[n+1]=znak[i]) then
          kolvo[i]:=kol+1;
    end;
    end;
    s1:='';
    s:='';
    for i:=1 to 51 do begin
       if kolvo[i]>0 then begin
          writeln('Slovo ',slovo[i],' vstrechaetsia ',kolvo[i],' raz');
    end;
 end;

uses crt;
const
 znak:array[1..14] of byte=(9,10,13,32,40,41,44,46,47,58,59,92,123,125);
var
 slovo:array[1..51] of string[15];
 {mass:array[1..51] of string;}
 mask:array[1..51] of byte;
 txt:array[1..60000] of char;
 kol:byte;
 ns:byte;
 f1:text;
 f:file of char;
 simv:char;
 flag:boolean;
 j:byte;
 n:byte;
 dtxt:word;
 i:word;
 s,s1,temp:string;
begin
 clrscr;
 write('Vvedite ymia ishodnogo faila: ');
 readln(s);
 assign(f,s);
 {$I-} reset(f); {$I+}
  if ioresult<>0 then begin
     writeln('file not found or read error!');
     readkey;
     close(f);
     halt(1);
  end;
i:=1;
for i:=1 to 51 do mask[i]:=0;
i:=1;
slovo[1]:='and';slovo[2]:='asm';slovo[3]:='array';slovo[4]:='begin';slovo[5]:='case';
slovo[6]:='const';slovo[7]:='constructor';slovo[8]:='destructor';slovo[9]:='div';slovo[10]:='do';
slovo[11]:='downto';slovo[12]:='else';slovo[13]:='end';slovo[14]:='exports';slovo[15]:='file';
slovo[16]:='for';slovo[17]:='function';slovo[18]:='goto';slovo[19]:='if';slovo[20]:='implementation';
slovo[21]:='in';slovo[22]:='inherited';slovo[23]:='inline';slovo[24]:='interface';slovo[25]:='label';
slovo[26]:='library';slovo[27]:='mod';slovo[28]:='nil';slovo[29]:='not';slovo[30]:='object';
slovo[31]:='of';slovo[32]:='or';slovo[33]:='packed';slovo[34]:='procedure';slovo[35]:='program';
slovo[36]:='record';slovo[37]:='repeat';slovo[38]:='set';slovo[39]:='shl';slovo[40]:='shr';
slovo[41]:='string';slovo[42]:='then';slovo[43]:='to';slovo[44]:='type';slovo[45]:='unit';
slovo[46]:='until';slovo[47]:='uses';slovo[48]:='var';slovo[49]:='while';slovo[50]:='with';slovo[51]:='xor';
  write('Vvedite imia novogo faila: ');
  readln(s1);
  assign(f1,s1);
  {$I-} rewrite(f1); {$I+}
   if ioresult<>0 then begin
      writeln('error writing file!');
      readkey;
      close(f1);
      halt(1);
   end;
   s:=''; s1:=''; temp:='';
   kol:=0;
   n:=0;
 while not eof(f) do begin
   read(f,simv);
   inc(dtxt);
   ns:=ord(simv);
   txt[dtxt]:=chr(ns);
    for i:=1 to dtxt do begin
        ns:=ord(txt[i]);
        flag:=true;
        for j:=1 to 14 do begin
        if ns=znak[j] then flag:=false;
          if flag then s:=s+txt[i];
         for n:=1 to 51 do begin
           if s=slovo[n] then begin
             mask[n]:=kol+1;
             i:=1;
             for i:=1 to 51 do begin
               n:=i;
               if mask[n]>0 then begin
                write('Slovo : ' ,slovo[n]);
                writeln('vstrechaetsia : ',mask[n],' raz');
                s1:=slovo[n];
                writeln(f1,s1);
               end;
              end;
            end;end;end;end;end; {<== ЗДЕСЬ ПРОГРАММА ОСТАНАВЛИВАЕТСЯ НАМЕРТВО, ВЫХОЖУ ctrl+break}
readln;
close(f);
close(f1);
end.

...
  for j:=1 to 14 do begin
    if ns=znak[j] then flag:=false;
    if flag then s:=s+txt[i]; { <-- следующий символ из файла НЕ читается... }
...