program Project1;
const
N = 200;
type
TNumInfo = record
Num : Integer;
Cnt : Integer;
end;
TArrNums = array[1..N] of TNumInfo;
(*Обновляет статистику по числу aNum - если число уже есть в массиве, то увеличивает его счётчик,
если числа нет в массиве, то добавляет сведения о нём.*)
procedure AddToArr(var aArr : TArrNums; const aNum : Integer; var aN : Integer);
var
i : Integer;
BFound : Boolean;
begin
(*Если запись о числе уже есть в массиве, то увеличиваем счётчик в этой записи.*)
BFound := False;
for i := Low(aArr) to aN do begin
if aArr[i].Num = aNum then begin
Inc( aArr[i].Cnt );
BFound := True;
Break;
end;
end;
(*Если записи в массиве нет - добавляем запись.*)
if not BFound then begin
Inc(aN);
aArr[aN].Num := aNum;
aArr[aN].Cnt := 1;
end;
end;
(*Извлекает из строки числа и добавляет их в массив.*)
procedure ProcStr(const aStr : String; var aArr : TArrNums; var aN : Integer);
const
(*Множество цифр.*)
D = ['0'..'9'];
(*Множество разделитлей.*)
Dl = [
' ', #9, #10, #13,
'.', ',', ':', ';',
'+', '-', '*', '/', '=', '#', '''',
'(', ')', '[', ']', '{', '}'
];
var
(*i - Индекс символов в строке, Pos1, Pos2 - позиции начала и конца записи числа.*)
i, Pos1, Pos2, Num, ErrCode : Integer;
begin
(*Выделяем целые числа и помещаем их в массив.*)
Pos1 := 0;
Pos2 := 0;
for i := 1 to Length(aStr) do begin
(*Пропускаем знаки, отличные от цифр.*)
if not (aStr[i] in D) then Continue;
(*Отслеживаем начало записи числа.*)
if i = 1 then
Pos1 := i
else if aStr[i - 1] in Dl then
Pos1 := i
;
(*Отслеживаем конец записи числа.*)
if Pos1 > 0 then begin
if i = Length(aStr) then
Pos2 := i
else if aStr[i + 1] in Dl then
Pos2 := i
;
end;
(*Если найден конец записи числа.*)
if Pos2 > 0 then begin
(*Определяем число.*)
Val(Copy(aStr, Pos1, Pos2 - Pos1 + 1), Num, ErrCode);
(*Обновляем статистику.*)
AddToArr(aArr, Num, aN);
(*Обнуляем флаги.*)
Pos1 := 0;
Pos2 := 0;
end;
end;
end;
var
F : Text;
Arr : TArrNums;
i, j : Integer;
Str1 : String;
begin
j := 0;
repeat
Writeln('Задайте имя файла:');
Readln(Str1);
(*Попытка открытия файла.*)
Assign(F, Str1);
{$I-}
Reset(F);
{$I+};
if IOResult <> 0 then begin
Writeln('Ошибка! Не удалось открыть файл с заданным именем.');
Writeln('Возможно файла с таким именем не существует.');
Writeln('Действие отменено.');
Str1 := '';
Continue;
end;
(*Обработка файла.*)
while not Eof(F) do begin
Readln(F, Str1);
ProcStr(Str1, Arr, j);
end;
(*Закрываем файл.*)
Close(F);
(*Вывод результатов.*)
Writeln('Найдено различных чисел: ', j);
for i := Low(Arr) to j do begin
Writeln('Число: ', Arr[i].Num, ', количество: ', Arr[i].Cnt);
end;
Writeln('Выход - Enter, повторить - любой символ + Enter.');
Readln(Str1);
until Str1 <> '';
end.