Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 18.05.2012, 01:20   #11
Начинающий програм
Форумчанин
 
Аватар для Начинающий програм
 
Регистрация: 22.11.2011
Сообщений: 201
По умолчанию

Помогите пожалуйста!
Начинающий програм вне форума Ответить с цитированием
Старый 18.05.2012, 12:07   #12
BDA
МегаМодератор
СуперМодератор
 
Аватар для BDA
 
Регистрация: 09.11.2010
Сообщений: 7,291
По умолчанию

Код:
program Project3;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  windows;

type
  Tsession = array[1..10, 1..5] of record
    name: string[10];
    mark: 1..5;
  end;
  student = record
    FIO: string[40];
    curs: 1..5;
    group: 1..9;
    results: Tsession;
  end;
  TFile = file of student;
var k: integer;
  fname: string;
  f: TFile;

procedure Read_student(var st: student);
var
  i, j: integer;
begin
  with st do
  begin
    write('Введите ФИО: ');
    readln(FIO);
    write('Введите курс: ');
    readln(curs);
    write('Введите группу: ');
    readln(group);
    writeln('Введите результаты сессий:');
    i := 1;
    repeat
      writeln('Сейссия №', i, ': ');
      for j := 1 to 5 do
      begin
        write('Название ', j, '-го экзамена: ');
        readln(results[i, j].name);
        write('Оценка за ', j, '-й экзамен: ');
        readln(results[i, j].mark);
      end;
      inc(i);
    until (i = curs * 2 + 1);
  end;
  writeln('Ввод закончен!');
end;

procedure write_student(var st: student);
var
  i, j: integer;
begin
  with st do
  begin
    writeln(FIO, ', ', curs, ' курс, ', group, ' группа.');
    for i := 1 to curs * 2 do
    begin
      write('  Сессия ', i, ': ');
      for j := 1 to 5 do
        write(results[i, j].name, ': ', results[i, j].Mark, ', ');
      writeln;
    end;
  end;
end;

procedure New_file(var f: tfile; var name: string);
begin
  write('Имя нового файла: ');
  readln(name);
  if not fileexists(name) then
  begin
    assign(f, name);
    rewrite(f);
    writeln('Файл "', name, '" создан!');
    closefile(f);
  end;
end;

procedure Open_file(var f: tfile; var name: string);
begin
  write('Имя файла для открытия: ');
  readln(name);
  assignfile(f, name);
  reset(f);
  closefile(f);
  writeln('Файл "', name, '" открыт!');
end;

procedure Add_rec(var f: tfile; var name: string);
var
  rec: student;
  i, n: integer;
begin
  reset(f);
  seek(f, Filesize(f));
  readln(n);
  for i := 1 to n do
  begin
    writeln('Ввод ', i, ' студента из ', n);
    Read_student(rec);
    write(f, rec);
    writeln('Запись добавлена!');
  end;
  closefile(f)
end;

procedure Task(var f: tfile; var name: string);
var
  n, i: integer;
  rec: student;
  f2: tfile;
  b, c, d: boolean;
  name2: string;
begin
  write('Введите имя файла для результатов: ');
  readln(name2);
  reset(f);
  assign(f2, name2);
  rewrite(f2);
  writeln('Файл "', name2, '" создан!');
  write('Ищем записи, удовлетворяющие условию... ');
  for n := 0 to Filesize(f) - 1 do
  begin
    b := true;
    c := true;
    i := 1;
    d := true;
    seek(f, n);
    read(f, rec);
    while (i <= 5) and d do
    begin
      if (rec.results[rec.curs * 2, i].mark < 4) then d := false;
      inc(i);
    end;
    i := 1;
    if d then
    begin
      while c and (i <= 5) do
      begin
        if rec.results[rec.curs * 2, i].mark = 5 then
          if b = true then
            b := false
          else
            c := false;
        inc(i);
      end;
      if c then
      begin
        writeln('Найдена запись ', n + 1);
        write(f2, rec);
      end;
    end;
  end;
  closefile(f);
  closefile(f2);
end;

procedure View_file(var f: tfile; var name: string);
var
  i: integer;
  rec: student;
begin
  reset(f);
  for i := 0 to Filesize(f) - 1 do
  begin
    read(f, rec);
    write('№', i + 1, ' ');
    write_student(rec);
  end;
  writeln('Вывод закончен!');
  closefile(f);
end;

begin
  SetConsoleCP(1251);
  SetConsoleOutputCP(1251);
  New_file(f, fname);
  Open_file(f, fname);
  Add_rec(f, fname);
  Task(f, fname);
  View_file(f, fname);
  readln;
end.
Вот так вывод работает. Как работает task я не понял, пока он вообще ничего не ищет.
Пишите язык программирования - это форум программистов, а не экстрасенсов. (<= это подпись )
BDA вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
задача Delphi на файлы KarolinaGree Помощь студентам 7 10.05.2012 22:46
Задания по теме файлы Бени Паскаль, Turbo Pascal, PascalABC.NET 1 05.01.2011 22:17
Задача по теме "файлы" Aleo13 Паскаль, Turbo Pascal, PascalABC.NET 13 10.11.2008 21:30