Работа с файлами данных в Pascal

(******************************************************

* Задача: скопировать  все отрицательные  числа из      *

* одного файла вещественных  чисел в другой.           *

******************************************************)   

var

  SrcFile, DestFile: File of real; {файл-источник и файл-результат}

  SrcFileName, DestFileName: string; {имена файлов}

  nextelem: real; {следующий компонент файла}

  ask: char;  

(******************************************************

Процедура заполняет компонентный файл случайными

вещественными числами в заданном диапазоне

******************************************************)

procedure CreateFileOfReal;

var

  i, num: word;

  min, max, value, sign: real;

begin

  Rewrite(SrcFile); {открываем файл на запись}

  writeln('Введите количество компонентов файла '); readln(num);

  writeln('Введите нижнюю границу значений '); readln(min);

  writeln('Введите верхнюю границу значений '); readln(max);

  {если перепутаны границы, меняем их}

  if min>max then begin

    value:= min;

    min:= max;

    max:= value;

  end;

  {заполняем файл значениями}

  for i:=1 to num do begin

    value := random*(max-min)+min;

    sign := random;

    if sign>=0.5 then

      value := -value;

    write (SrcFile, value); {запись компонента в файл}

  end;

  Close(SrcFile); {закрываем файл - все данные сохранены}

end;  

begin

  writeln('Введите имя исходного файла '); readln(SrcFileName);

  Assign(SrcFile, SrcFileName);

  writeln('Нужно ли предварительно заполнить его? (д/н)'); readln(ask);

  if (ask='y')or(ask='Y')or(ask='д')or(ask='Д') then

    CreateFileOfReal;

  writeln('Введите имя файла-результата '); readln(DestFileName);

  Assign(DestFile, DestFileName);

  {открываем файлы}

  {$I-}

  Reset(SrcFile);

  {$I+}

  if IOResult<>0 then begin

    writeln('Ошибка: невозможно открыть исходный файл.');

    exit;

  end;

  Rewrite(DestFile);

  {собственно копирование значений}

  while not EOF(SrcFile) do begin

    read (SrcFile, nextelem);

    write ('Следующее значение = ',nextelem:8:3);

    if nextelem<0 then begin

      write (DestFile, nextelem);

      writeln (' - копируем');

      end

    else

      writeln(' - не копируем');

  end;

  {закрываем оба файла - сохраняем данные}

  Close (SrcFile);

  Close (DestFile);

end.

  writeln('Введите имя копируемого файла '); readln(SrcFileName);

  Assign(SrcFile, SrcFileName);

  {$I-}

  Reset(SrcFile);

  {$I+}

  errcode:=IOResult;

  if errcode<>0 then

    writeln('Ошибка: невозможно открыть исходный файл. Повторите ввод.');

until (errcode=0);

  Read (TextFile, char1, char2); {считаем, что charN имеет тип char}  

n  Readln (TextFile, char3);

end;

(******************************************************

* Задача: вывести все  русские буквы  из текстового     *

* файла на экран                                       *

******************************************************)   

const

  RusLetters : set of char = ['а'..'п','р'..'я','А'..'Я'];

var

  TextFile: Text;

  TextFileName: string;

  ch: char;

  errcode: integer;  

begin

  {вводим имя исходного файла}

  repeat

  writeln('Введите имя исходного файла '); readln(TextFileName);

  Assign(TextFile, TextFileName);

  {$I-}

  Reset(TextFile);

  {$I+}

  errcode:=IOResult;

  if errcode<>0 then

    writeln('Ошибка: невозможно открыть исходный файл. Повторите ввод.');

  until (errcode=0);   

  {выводим русские буквы}

  while not EOF (TextFile) do begin

    while not EOLn (TextFile) do begin

      Read (TextFile, ch);

      if ch in RusLetters then

        write(ch);

    end;

    Readln (TextFile);

  end;

end.

(******************************************************

* Задача: дан текстовый  файл, содержащий  программу на *

* некотором языке,  в котором один  оператор занимает   *

* строго одну строку. Проверить ее на  правильность    *

* скобочных конструкций.                              *

******************************************************)   

var

  Prg : text; {обрабатываемый файл}

  FileName : string;

  Opened, Closed : byte; {количество левых и правых скобок}

  StrNum: word; {номер строки}

  ch : char;

  ErrCode: integer;  

begin

  writeln('Программа решает следующую задачу:');

  writeln('Дан текстовый файл, содержащий программу на ');

  writeln('некотором языке, в котором один оператор занимает');

  writeln('строго одну строку. Проверить ее на правильность');

  writeln('скобочных конструкций.');

  writeln;  

  repeat

    write('Введите имя проверяемого файла ');

    readln(FileName);

    Assign(Prg, FileName);

    {$I-}

    Reset(Prg);

    {$I+}

    ErrCode:= IOResult;

    if ErrCode<>0 then

      writeln('Ошибка: невозможно открыть файл. Повторите ввод.');

  until ErrCode=0;  

  writeln('Проверяется файл "',FileName,'" :');

  StrNum:=1;

  while not EOF(Prg) do begin

    Opened:=0;

    Closed:=0;

    {считаем левые и правые скобки}

    while not EOLN(Prg) do begin

      read(Prg, ch);

      if ch='(' then

        Opened:=Opened+1

      else if ch=')' then

        Closed:=Closed+1;

    end;

    {проверяем их соответствие}

    if Opened>Closed then

      writeln('В [',StrNum,'] строке не хватает ',Opened-Closed,

              ' закрывающих скобок')

    else if Closed>Opened then

      writeln('В [',StrNum,'] строке не хватает ',Closed-Opened,

              ' открывающих скобок');

    readln(Prg); {переходим на следующую строку}

    StrNum:=StrNum+1;

  end;

  Close(Prg);

end.