Исправление ошибок. - Pascal

program p71;
const
n=10;// n только от 2 до 15!
var
Matrix:array[1..n,1..n]of byte;//только byte!
uni:set of byte;
i,j:byte;
begin
randomize;//инициализация генератора случайных чисел
uni:=[];
//создание матрицы
for i:=1 to n do
begin
for j:=1 to n do
begin
Matrix[i,j]:=Random(128);//генератор случайных чисел
write(Matrix[i,j]:3,' ');
end;
writeln;
end;
//поиск уникальных элементов
writeln;
writeln;
for i:=1 to n do
for j:=1 to n do uni:=uni + [Matrix[i,j]];
write('Unikalnye chisla: ');
for i:=0 to 255 do
if i in uni then write(i:3,' ');
writeln;
readln;
end.
program p9;
uses crt;
const
CEndOfFile='@';//Символ конца файла. Можно задать любой символ или их комбинацию
type
TPDict=^TDict;
TDict=record
data:string;
next:TPDict;
end;
var
f:text;
s,n,w:string;
RusLet,Nums,Words:integer;
Dict:TPDict;
//функция подсчёта цифр
function CountNums(data:string):integer;
var
res,i:integer;
begin
res:=0;
for i:=1 to length(data) do
if data[i] in ['0'..'9'] then inc(res);
CountNums:=res;
end;
 
//функция подсчёта русских букв
function CountRusLet(data:string):integer;
var
res,i:integer;
begin
res:=0;
for i:=1 to length(data) do
if byte(data[i]) in [128..255] then inc(res);//считаем НЕанглийские буквы
//Если надо считать другие символы - их коды ввести в квадратных скобках вместо [128..255]
CountRusLet:=res;
end;
 
//функция, приводящая все английские буквы к верхнему регистру
function UpCaseStr(data:string):string;
var
i:integer;
begin
for i:=1 to length(data) do data[i]:=UpCase(data[i]);
UpCaseStr:=data;
end;
 
//функция подсчёта вхождения слов
function CountWords(data,wrd:string):integer;
var
n,res,i:integer;
s:string;
begin
res:=0;
data:=UpCaseStr(data);
wrd:=UpCaseStr(wrd);
s:='';
for i:=1 to length(data) do
if byte(data[i]) > 32 then s:=s+data[i] else
begin
if s <> '' then
begin
if s=wrd then inc(res);
s:='';
end;
end;
if s=wrd then inc(res);
CountWords:=res;
end;
 
//функция проверяет наличие заданного слова в словаре
function IsWordExist(pdict:TPDict;wrd:string):boolean;
var
res:boolean;
begin
res:=false;
while pdict <> nil do
begin
if UpCaseStr(pdict^.data)=UpCaseStr(wrd) then
begin
res:=true;
break;
end;
pdict:=pdict^.next;
end;
IsWordExist:=res;
end;
 
//процедура создания словаря (если существует - дополняет)
//строка не обрабатывается
procedure CreateDict(var pdict:TPDict;dat:string);
var
wlist:TPDict;
begin
if pdict = nil then
begin
new(pdict);
pdict^.data:=dat;
pdict^.next:=nil;
end else
begin
wlist:=pdict;
while wlist^.next <> nil do wlist:=wlist^.next;
new(wlist^.next);
wlist:=wlist^.next;
wlist^.next:=nil;
wlist^.data:=dat;
end;
end;
 
//процедура пополнения словаря (если не существует - создаёт)
//автоматически разделяет строку на слова
procedure StrToDict(var pdict:TPDict;data:string);
var
s:string;
i:integer;
begin
s:='';
for i:=1 to length(data) do
if byte(data[i]) > 32 then s:=s+data[i] else
begin
if s <> '' then
begin
if not IsWordExist(pdict,s) then CreateDict(pdict,s);
s:='';
end;
end;
if s <> '' then
if not IsWordExist(pdict,s) then CreateDict(pdict,s);
end;
 
//процедура сортировки слов в словаре
procedure SortDict(var pdict:TPDict);
var
head,tmp1,tmp2,nf:TPDict;
n:string;
begin
head:=nil;
nf:=pdict;
repeat
tmp1:=nf;
tmp2:=tmp1;
n:=tmp1^.data;
while tmp1 <> nil do
begin
if UpCaseStr(tmp1^.data) < UpCaseStr(n) then
begin
tmp2:=tmp1;
n:=tmp1^.data;
end;
tmp1:=tmp1^.next;
end;
tmp1:=nf;
if tmp1 = tmp2 then nf:=tmp2^.next else
begin
while tmp1 <> nil do
begin
if tmp1^.next <> tmp2 then tmp1:=tmp1^.next else
begin
tmp1^.next:=tmp2^.next;
break;
end;
end;
end;
tmp2^.next:=nil;
if head=nil then head:=tmp2 else
begin
tmp1:=head;
while tmp1^.next <> nil do tmp1:=tmp1^.next;
tmp1^.next:=tmp2;
end;
until nf=nil;
pdict:=head;
end;
 
//процедура сохранения словаря в файл
procedure WriteDict(pdict:TPDict;path:string);
var
f:text;
begin
assign(f,path);
rewrite(f);
while pdict <> nil do
begin
writeln(f,pdict^.data);
pdict:=pdict^.next;
end;
close(f);
end;
 
//Освобождение памяти от нашего словарика
//(мы ж культурные и должны за собой прибраться )
procedure DestroyDict(var pdict:TPDict);
var
tmp1, tmp2:TPDict;
begin
tmp1:=pdict;
pdict:=nil;
while tmp1 <> nil do
begin
tmp2:=tmp1^.next;
Dispose(tmp1);
tmp1:=tmp2;
end;
end;
 
begin
//инициализация переменных
Nums:=0;
RusLet:=0;
Words:=0;
Dict:=nil;
//ввод пути и создание файла
clrscr;
write('Vvedite put k failu: ');
readln(n);
assign(f,n);
rewrite(f);
clrscr;
//ввод текста и запись его в файл
writeln('Vvedite tekst.');
writeln('Dlja okonchania vvedite na novoj stroke "@" (bez kavychek).');
writeln;
readln(s);
while s<>CEndOfFile do
begin
writeln(f,s);
readln(s);
end;
close(f);
//ввод слова для поиска
clrscr;
write('Vvedite slovo dlja poiska: ');
readln(w);
//открытие только что записанного файла на чтение
//и его анализ в соответствии с заданием
assign(f,n);
reset(f);
while not eof(f) do
begin
readln(f,s);
Nums:=Nums+CountNums(s);
RusLet:=RusLet+CountRusLet(s);
Words:=Words+CountWords(s,w);
StrToDict(Dict,s);
end;
close(f);
SortDict(Dict);
clrscr;
if Nums > RusLet then writeln('Tsyfr bolshe, chem russkih bukv') else
if Nums < RusLet then writeln('Russkih bukv bolshe, chem tsyfr') else writeln('Russkih bukv i tsyfr porovnu');
writeln('Slovo "',w,'" vhodit v tekst ',Words,' raz.');
write('Vvedite put k failu slovarja: ');
readln(s);
WriteDict(Dict,s);
DestroyDict(Dict);
writeln;
writeln('Press [Enter] for exit.');
readln;
end.
program p10;
var
s:string;
c:char;
n:integer;
f,h:text;
begin
//начало основной программы
write('Type path to input file: ');
readln(s);
assign(f,s);
reset(f);
write('Type path to output file: ');
readln(s);
assign(h,s);
rewrite(h);
writeln;
write('Input letter: ');
readln(c);
while not eof(f) do
begin
readln(f,s);
n:=Pos(c,s);
while n > 0 do
begin
Delete(s,n,1);
n:=Pos(c,s);
end;
writeln(h,s);
end;
writeln;
writeln('Finished. Press [Enter] for exit.');
readln;
end.