Технический форум
Вернуться   Технический форум > Программирование > Форум программистов > Помощь студентам


Ответ
 
Опции темы Опции просмотра
Старый 26.09.2012, 20:06   #1 (permalink)
lenchik1
Новичок
 
Регистрация: 26.09.2012
Сообщений: 7
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию Найти ошибки

Код:
rogram Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  windows;

const n=20;
type
tstudent = record
             name:string[10];
             kurs:Byte;
             group:Byte;
             spec:string[10];
             mark:String[9];
           end;
tmas=array [1..n] of tstudent;
tfile=file of tstudent;
var a:tmas;
    f,f1:Text;
    f2:tfile;
    s:String;

 //-----------------------------------------------------------------
procedure vvoddannuh(var a:tmas);
var i:Integer;
p:tstudent;
begin
  Rewrite(f);
  writeln (f,'------------------------------------------------------------');
  writeln (f,'   фио    /к/г/ спец-ть  /оценки     ');
  writeln (f,'------------------------------------------------------------');
  for i:=1 to n do
     with p do
  begin
    Write('введи фамилию');
    Readln(f,name);
    Write('введи курс');
    Readln(f,kurs);
    Write('введи специальность');
    Readln(f,spec);
    Write('введи результат последней сессии');
    Readln(f,mark);
    writeln(f,name:10,kurs:1,spec:10,mark:9);
    writeln
  end;
    Close(f)
end;
//------------------------------------------------------------------------------
Procedure printdannuh(a:tmas);
var i:Integer;
begin
   Rewrite(f1);
   Rewrite(f2);
   writeln (f1,'------------------------------------------------------------');
   writeln (f1,'   фио    /к/г/ спец-ть  /оценки     ');
   writeln (f1,'------------------------------------------------------------');
   for i:=1 to n do
  With a[i] Do
   begin
      writeln(f1,name,kurs,spec,mark);
      write(f2,a[i])
   end;
 Close(f1);
 Close(f2);
end;
//-----------------------------------------------
procedure read_info( a:tmas);
 var i:integer;
  begin
    Reset(f);
    readln(f);
    readln(f);
    readln(f);
    for i:=1 to n do
      With a[i] Do
      begin
         Readln(f,name,kurs,group,spec,mark);
         //Здесь нужно убрать лишние пробелы ...
         name:=TrimLeft(name);
         spec:=TrimLeft(spec)
      end;
    Close(f)

  end;

procedure sort(var a:tmas);
var x:tstudent; i,j:integer;
 begin
   for i:=1 to n-1 do
   for j:=1 to n-i do
    begin
    if a[j].kurs>a[j+1].kurs then
     begin
      x:=a[j]; a[j]:=a[j+1]; a[j+1]:=x;
     end;
    if a[j].kurs=a[j+1].kurs then
      if a[j].group>a[j+1].group then
      begin
       x:=a[j]; a[j]:=a[j+1]; a[j+1]:=x;
      end;
    end;
 end;

procedure Odnofam (r:byte; a:tmas);
var i,j,kk,k: byte; aa:tmas; s,ss: string; f1: Text; f3:tfile;
begin
  Append(f1);
  Reset(f2);
  Seek(f2,FileSize(f2)); //Указатель в конец файла
  Writeln(f1);
 s:='Список групп, в которых есть однофамильцы: ';
 k:=0;
for i:=1 to r do
    for j:=i+1 to r do
           with a[i] do
                if a[i].name=a[j].name then
                begin
                  inc(k);
                  kk:=0;
                  str(a[i].group,ss);
                  ss:=' '+ss+' ';
                  if pos(ss,s)=0 then s:=s+ss;
                  if kk=0 then
                     aa[k]:=a[i]
                end;
   if k>=1 then
     for i:=1 to k do
        with aa[i] do
        begin
           Writeln(f1,'Фио', name);
           Writeln(f1,'к', kurs);
           Writeln(f1,'г', group);
           Writeln(f1,'спец-ть', spec);
           Writeln(f1,'оценки',mark);
           Writeln(f1);
           Write(f2,aa[i])
        end
   else
     writeln('таких групп нет');
writeln(s);
Close(f1);
Close(f2);
readln;
end;


begin
 setconsoleoutputcp(1251);
 SetConsoleCP(1251);
 Assign(f,'список.txt');
 Assign(f1,'список2.txt');
 Assign(f2,'список3.dat');
 if FileExists('список.txt') then
    begin
     read_info(a);
     Reset(f);
     while not Eof(f) do
     begin
       Readln(f,s);
       Writeln(s)
     end;
     Close(f);
     sort(a);
     writeln('список отсортирован');
     printdannuh(a);
     Odnofam(n,a);
     Reset(f1);
      while not Eof(f1) do
     begin
       Readln(f1,s);
       Writeln(s)
     end;
     Close(f1);
     end
 else
    vvoddannuh(a);
 Readln
end.
Создать массив из 20-ти элементов, хранящий информацию о студентах. Каждый элемент содержит: фамилию, курс, форму обучения (специалист, бакалавр, магистр) и оценки по 5 предметам за последнюю сессию. Упорядочить массив по курсу, внутри курса - по группе. Найти группы, в которых есть однофамильцы. Распечатать их фамилии и оценки за последнюю сессию.
задача зависает при запуске
lenchik1 вне форума   Ответить с цитированием

Старый 26.09.2012, 20:06
Helpmaster
Member
 
Аватар для Helpmaster
 
Регистрация: 08.03.2016
Сообщений: 0

Не стоит делать поспешных действий, полистайте аналогичные проблемы

Ошибки на Casemods.ru
Ошибки при запуске игр
Pascal, нужно найти ошибки
Помогите найти ошибки. Си++

Старый 26.09.2012, 21:02   #2 (permalink)
Vladimir_S
Специалист
 
Аватар для Vladimir_S
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 26,347
Сказал(а) спасибо: 288
Поблагодарили 507 раз(а) в 165 сообщениях
Репутация: 91953
По умолчанию

Цитата:
Сообщение от lenchik1 Посмотреть сообщение
задача зависает при запуске
Угу. Потому что там ошибка (и даже серия ошибок) в процедуре vvoddannuh. Считывая вводимые данные с консоли, Вы зачем-то всюду ставите Readln(f, . Это - грубейшая ошибка. Уберите ссылки на файл! Ну и заодно - не вижу, чтобы в этой процедуре присваивались значения элементам массива записей a, что-нибудь вроде a[i]:=p; - раз уж Вы объявляете это самое a выходным параметром. Не говоря уж о пропущенном вводе значения поля group. В общем, отлаживайте, и лучше - самостоятельно. Удачи!
__________________
With Mozilla Firefox - straight to communism!
Vladimir_S на форуме   Ответить с цитированием
Старый 27.09.2012, 19:01   #3 (permalink)
lenchik1
Новичок
 
Регистрация: 26.09.2012
Сообщений: 7
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию

Код:
program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  windows;

const n=20;
type
tstudent = record
             name:string[10];
             kurs:Byte;
             group:Byte;
             spec:string[10];
             mark:String[5];
           end;
tmas=array [1..n] of tstudent;
tfile=file of tstudent;
var a:tmas;
    f,f1,f3:Text;
    f2:tfile;
    s:String;

 //-----------------------------------------------------------------
procedure vvoddannuh;
var i:Integer;
    p:tstudent;
begin
  Rewrite(f);
  writeln (f,'------------------------------------------------------------');
  writeln (f,'   фио    /к/г/ спец-ть  /оценки     ');
  writeln (f,'------------------------------------------------------------');
  for i:=1 to n do
     with p do
  begin
    Write('введи фамилию');
    Readln(name);
    Write('введи курс');
    Readln(kurs);
    Write('введи группу');
    Readln(group);
    Write('введи специальность');
    Readln(spec);
    Write('введи результат последней сессии');
    Readln(mark);
    writeln(f,name:10,kurs:1,group:1,spec:10,mark:5);
    writeln
  end;
    Close(f)
end;
//------------------------------------------------------------------------------
Procedure printdannuh(a:tmas);
var i:Integer;
begin
   Rewrite(f1);
   //Rewrite(f2);
   writeln (f1,'------------------------------------------------------------');
   writeln (f1,'   фио    /к/г/ спец-ть  /оценки     ');
   writeln (f1,'------------------------------------------------------------');
   for i:=1 to n do
  With a[i] Do
   begin
      writeln(f1,name,kurs,group,spec,mark);
     // write(f2,a[i])
   end;
 Close(f1);
 //Close(f2);
end;
//-----------------------------------------------

procedure read_info( a:tmas);
 var i:integer;
  begin
    Reset(f);
    readln(f);
    readln(f);
    readln(f);
    for i:=1 to n do
     //With a[i] Do
      begin
         Readln(f,a[i].name,a[i].kurs,a[i].group,a[i].spec,a[i].mark);
         //Здесь нужно убрать лишние пробелы ...
        // name:=TrimLeft(name);
        // spec:=TrimLeft(spec)
      end;
    Close(f)

  end;

procedure sort(var a:tmas);
var x:tstudent; i,j:integer;
 begin
   for i:=1 to n-1 do
   for j:=1 to n-i do
    begin
    if a[j].kurs>a[j+1].kurs then
     begin
      x:=a[j]; a[j]:=a[j+1]; a[j+1]:=x;
     end;
    if a[j].kurs=a[j+1].kurs then
      if a[j].group>a[j+1].group then
      begin
       x:=a[j]; a[j]:=a[j+1]; a[j+1]:=x;
      end;
    end;
 end;
//------------------------------------------------------------------------------
procedure Odnofam (r:byte; a:tmas);
var i,j,kk,k: byte; aa:tmas; s,ss: string; f3: Text; f2:tfile;
begin
  Assign(f3,'list3.txt');
  assign(f2,'list_3.dat');
  Rewrite(f3);
  Rewrite(f2);
 Seek(f2,FileSize(f2)); //Указатель в конец файла
 Writeln(f3);
 s:='Список групп, в которых есть однофамильцы: ';
 k:=0;
for i:=1 to r do
    for j:=i+1 to r do
           with a[i] do
                if a[i].name=a[j].name then
                begin
                  inc(k);
                  kk:=0;
                  str(a[i].group,ss);
                  ss:=' '+ss+' ';
                  if pos(ss,s)=0 then s:=s+ss;
                  if kk=0 then
                     aa[k]:=a[i]
                end;
   if k>=1 then
     for i:=1 to k do
        with aa[i] do
        begin
           Writeln(f3,'Фио', name);
           Writeln(f3,'к', kurs);
           Writeln(f3,'г', group);
           Writeln(f3,'спец-ть', spec);
           Writeln(f3,'оценки',mark);
           Writeln(f3);
           Write(f2,aa[i])
        end
   else
     writeln('таких групп нет');
writeln(s);
Close(f3);
Close(f2);
readln;
end;
//------------------------------------------------------------------------------

begin
 setconsoleoutputcp(1251);
 SetConsoleCP(1251);
 Assign(f,'list_1.txt');
 Assign(f1,'list_2.txt');
 Assign(f2,'list_3.dat');
 if FileExists('list_1.txt') then
    begin
     read_info(a);
     Reset(f);
     while not Eof(f) do
     begin
       Readln(f,s);
       Writeln(s)
     end;
     Close(f);
     sort(a);
     writeln('список отсортирован');
     printdannuh(a);
     Odnofam(n,a);
     Reset(f1);
      while not Eof(f1) do
     begin
       Readln(f1,s);
       Writeln(s)
     end;
     Close(f1);
     end
 else
    vvoddannuh;
 Readln
end.
вот исправила вроде,но теперь вместо однофамильцев 0 выводит.может кто подскажет что исправить надо
lenchik1 вне форума   Ответить с цитированием
Старый 27.09.2012, 19:49   #4 (permalink)
Vladimir_S
Специалист
 
Аватар для Vladimir_S
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 26,347
Сказал(а) спасибо: 288
Поблагодарили 507 раз(а) в 165 сообщениях
Репутация: 91953
По умолчанию

Цитата:
Сообщение от lenchik1 Посмотреть сообщение
вот исправила вроде,но теперь вместо однофамильцев 0 выводит.может кто подскажет что исправить надо
Тут скорее всего ошибка связана с повторным определением одних и тех же файлов - как в начале тела программы, так и в процедуре Odnofam. Так делать нельзя. Уберите из списка параметров процедуры файл f2 (он уже определен, как глобальный) и из тела процедуры оператор Assign(f2...).
__________________
With Mozilla Firefox - straight to communism!
Vladimir_S на форуме   Ответить с цитированием
Старый 27.09.2012, 20:45   #5 (permalink)
lenchik1
Новичок
 
Регистрация: 26.09.2012
Сообщений: 7
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию

а процедура read info правильно сделана?
lenchik1 вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
Старый 27.09.2012, 20:49   #6 (permalink)
lenchik1
Новичок
 
Регистрация: 26.09.2012
Сообщений: 7
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию

я убрала,но все равно 0 выводит(((((((((
lenchik1 вне форума   Ответить с цитированием
Старый 27.09.2012, 20:54   #7 (permalink)
Vladimir_S
Специалист
 
Аватар для Vladimir_S
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 26,347
Сказал(а) спасибо: 288
Поблагодарили 507 раз(а) в 165 сообщениях
Репутация: 91953
По умолчанию

Цитата:
Сообщение от lenchik1 Посмотреть сообщение
а процедура read info правильно сделана?
Да вроде - во всяком случае, ошибки не торчат.
__________________
With Mozilla Firefox - straight to communism!
Vladimir_S на форуме   Ответить с цитированием
Старый 27.09.2012, 20:58   #8 (permalink)
Vladimir_S
Специалист
 
Аватар для Vladimir_S
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 26,347
Сказал(а) спасибо: 288
Поблагодарили 507 раз(а) в 165 сообщениях
Репутация: 91953
По умолчанию

Цитата:
Сообщение от lenchik1 Посмотреть сообщение
я убрала,но все равно 0 выводит(((((((((
Лена, поймите правильно: у меня просто физически нет возможности засесть за отладку Вашей программы. И вообще отладка - это то, что каждый программист должен уметь делать самостоятельно. Да, тяжелая (особенно если опыта нет) работа - но в то же время интересная и творческая. А рассчитывать в таком деле на форумы - пустое. Уж поверьте.
__________________
With Mozilla Firefox - straight to communism!
Vladimir_S на форуме   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
Ответ

Опции темы
Опции просмотра

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Выкл.
HTML код Выкл.
Trackbacks are Вкл.
Pingbacks are Вкл.
Refbacks are Выкл.




Часовой пояс GMT +4, время: 19:51.

Powered by vBulletin® Version 6.2.5.
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.