Форум «Всё о Паскале» > В этом коде определенно есть ошибка!

Помощь - Поиск - Пользователи - Календарь

Полная версия: В этом коде определенно есть ошибка!

Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи

iSlayter

28.04.2007 14:12

Проблема в том, что в файле после его заполнения есть данные, а процедуры Print и ShowInfo не срабатывают. Вообще ничего не выдают.

Помогите, пожалуйста, разобраться с данной проблемой.
Надеюсь на понимание.

С уважением,
Юрий.

program rec;
uses crt;
type

   TRec = record
      name       : string [31];
      bornyear   : integer;
      bornmonth  : integer;
      bornday    : integer;
      adress     : string [250];
   end;

   TBase = array [1..100] of TRec;

   TFile = file of TBase;
  
   
   
   
    
procedure ShowInfo (var b : TBase; var f : TFile; x : integer; k : integer);
var
  i : byte;
begin
   read(f, b);
   writeln('Infromation about mans : ');
   for i := 1 to k do
    with b[i] do begin
     if bornyear > x then begin
       writeln('Name : ' , name);
       writeln('Born day: ' , bornday , '; Born month: ' , bornmonth , 'Born year: ' , bornyear);
       writeln('Adress: ' , adress);
       writeln;
     end;
    end;
end;





procedure Input(var b : TBase; var f : TFile; var k : integer);
var
   i : byte;
begin
  writeln('Vvod bazy dannyx. ');writeln('');
   for i := 1 to k do
    with b[i] do begin
       writeln('Chelovek N ',i);
       write('Name : '); readln(name);
       write('Born day: '); readln(bornday); write('Born month: '); readln(bornmonth); write('Born year: '); readln(bornyear);
       write('Adress: '); readln(adress);
       writeln;
    end;
   write(f, b);
end;



procedure Print(var b : TBase; var f : TFile; var k : integer);
var
   i : byte;
begin
   read(f, b);
   writeln('Infromation about mans : ');
   for i := 1 to k do
    with b[i] do begin
       writeln('Name : ' , name);
       writeln('Born day: ' , bornday , '; Born month: ' , bornmonth , 'Born year: ' , bornyear);
       writeln('Adress: ' , adress);
       writeln;
    end;
end;





var
   base     : TBase;
   baseFile : TFile;
   birthYr  : integer;
   temp     : integer;
   k        : integer;
   
   
   
begin
 CLRSCR;
 temp := -1;
 assign(baseFile, 'c:\students.db');  
 
while temp <> 0 do
 begin
 
  CLRSCR;
  write('1 - create database; 2 - mans which born after X year; 3 - prints database; 0 - exit ... ');
  readln(temp);
  
  
  if temp = 1 then
   begin
    rewrite(baseFile);
    Write('Enter count fo rows for file: '); Readln(k);
    Input(base, baseFile, k);
    writeLn('Press any key ...'); ReadKey;
    close(baseFile);
   end;
   
   
  if temp = 2 then
   begin
    reset(baseFile);
    write('Enter start birthyear: ');
    readln(birthYr);
    ShowInfo(base, baseFile, birthYr, k);
    close(baseFile);
   end;
   
   
  if temp = 3 then
   begin
    reset(baseFile);
    Print(base, baseFile, k);
    close(baseFile);
   end;
   
  
 end;
 
 writeln('Press any button for exit ...');
 ReadKey
end.

volvo

28.04.2007 15:01

Цитата

а процедуры Print и ShowInfo не срабатывают

Срабатывают, только ты этого не успеваешь увидеть...

procedure Print(var b : TBase; var f : TFile; var k : integer);
var
   i : byte;
begin
   read(f, b);
   writeln('Infromation about mans : ');
   for i := 1 to k do
    with b[i] do begin
       writeln('Name : ' , name);
       writeln('Born day: ' , bornday , '; Born month: ' , bornmonth , 'Born year: ' , bornyear);
       writeln('Adress: ' , adress);
       writeln;
    end;
    ReadLn; { <--- Добавь это !!! }
end;

, аналогично - в ShowInfo ...

Altair

28.04.2007 15:33

iSlayter, а почему вы не используете отладчик?
Вопрос не возник бы...

iSlayter

2.05.2007 5:16

Цитата(Altair @ 28.04.2007 12:33)

iSlayter, а почему вы не используете отладчик?
Вопрос не возник бы...

Не знаю ни одного дебагера для паскаля

Прошу посмотреть в последний раз, честное слово!
Всё переписал немного. Ну и это уже для другого человека лаба.
Вообщем проблема такая - есть процедура записи новых рекордов в файл, и есть процедура удаления их из файла. Соответственно процедуры с именами Add и Delete. Помогите пожалуйста разобраться! Алгоритм вроде бы верный, но изменения не вносятся - вероятно некорректно их записываю! Или всё же есть ошибка в алгоритме?

program rec;
uses crt;
type
   TRec = record
      name       : string [31];
      result     : real;
      startnum   : integer;
   end;
   TBase = array [1..100] of TRec;
   TFile = file of TBase;

   
   
   
procedure Delete ( var b : TBase; var f : TFile; var k : integer)   ;
var
  i, g : byte;
  endv : integer;
begin
  read (f, b);
  endv := filesize(f)+1;
  For i := 1 to endv do if k = b[i].startnum then g := i;
  For i := g to (endv-1) do b[i] := b[i+1];
  endv  := endv-1;
  write(f, b);
  writeln('Sportsmen was successfully deleted.');
  write('Press any button for return to menu.');
  ReadKey;
end;




procedure Add (var b : TBase; var f : TFile; var k : integer);
var
  i, start, endv : byte;
begin
  read (f, b);
  writeln(filesize(f));
  start  := (filesize(f)+1);
  endv   := (start+k-1);
  seek (f, (filesize(f)+1));
  for i := start to endv do
    begin
       writeln('Chelovek N ' , i);
       write('Name: '); readln(b[i].name);
       write('Startnum: '); readln(b[i].startnum);
       write('The result: '); readln(b[i].result);
       writeln;
    end;
   write(f, b);
   write('Press any button for return to menu.');
   ReadKey;
end;




procedure ShowInfo (var b : TBase; var f : TFile);
var
  i : byte;
  min, max   : real;
  mini, maxi : integer;
begin
   read(f, b);
   writeln('Infromation about mans : ');
   for i := 1 to (FileSize(f)+1) do
    with b[i] do begin
	maxi := 1;
	mini := 1;
	min  := 0;
	max  := 0;
	if min < result then
	 begin
	  min  := result;
	  mini := i;
	end;
	if max > result then
	 begin
	  max  := result;
	  maxi := i;
	end;
    end;
    if mini = maxi then
     begin
      writeln('oops! ' , b[mini].name , ' is first and last at the same time!');
     end
    else
     begin
      writeln('First is ' , b[mini].name , ' in time ' , b[mini].result:6:3 , '!');
      writeln('Last is ' , b[maxi].name , ' in time ' , b[maxi].result:6:3 , '!');
     end;
   write('Press any button for return to menu.');
   ReadKey;
end;




procedure Input(var b : TBase; var f : TFile; var k : integer);
var
   i : byte;
begin
  writeln('Creating database. ');writeln;writeln;
  writeln('If sportsmen does not take part in competitions write 0 in "Result" field.');
   for i := 1 to k do
    with b[i] do begin
       writeln('Man N ',i);
       write('Name: '); readln(name);
       write('Startnum: '); readln(startnum);
       write('The result: '); readln(result);
       writeln;
    end;
   write(f, b);
   write('Press any button for return to menu.');
   ReadKey;
end;




procedure Print(var b : TBase; var f : TFile);
var
   i : byte;
begin
   read(f, b);
   writeln('Infromation about mans : ');
   for i := 1 to (FileSize(f)) do
    with b[i] do begin
       writeln('Name: ' , name);
       writeln('Startnum: ' , startnum , ';');
       writeln('Result: ' , result:6:3 , ';');
       writeln;
    end;
   write('Press any button for return to menu.');
   ReadKey;
end;





var
   base     : TBase;
   baseFile : TFile;
   birthYr  : integer;
   temp     : integer;
   k        : integer;
begin
 CLRSCR;
 temp := -1;
 assign(baseFile, 'c:\students.db');
while temp <> 0 do
 begin
  CLRSCR;
  writeln('1 - create database(rewrite file);');
  writeln('2 - first and last sportsmen;');
  writeln('3 - prints database;');
  writeln('4 - add information in database;');
  writeln('5 - edit info;');
  writeln('6 - delete information from DB;');
  writeln('0 - exit.');
  readln(temp);

  if temp = 1 then
   begin
    rewrite(baseFile);
    Write('Enter count of rows for file: '); Readln(k);
    Input(base, baseFile, k);
    close(baseFile);
   end;

  if temp = 2 then
   begin
    reset(baseFile);
    ShowInfo(base, baseFile);
    close(baseFile);
   end;

  if temp = 3 then
   begin
    reset(baseFile);
    Print(base, baseFile);
    close(baseFile);
   end;

   if temp = 4 then
    begin
     reset(baseFile);
     write('How many rows you want to add in database? '); readln(k);
     Add(base, baseFile, k);
     close(baseFile);
    end;

   if temp = 6 then
    begin
     reset(baseFile);
     write('Enter number of deleting sportsmen: '); readln(k);
     Delete(base, baseFile, k);
     close(baseFile);
    end;
 end;
 writeln('Press any button for exit ...');
 ReadKey
end.

С уважением,
Юрий

iSlayter

3.05.2007 4:37

кто-нибудь, помогите разобраться!

iSlayter

5.05.2007 2:25

up! ещё актуально!

мисс_граффити

5.05.2007 4:10

А зачем ты в файл пишешь массив, а не сами записи (рекорды)?

iSlayter

5.05.2007 21:17

Цитата(мисс_граффити @ 5.05.2007 1:10)

А зачем ты в файл пишешь массив, а не сами записи (рекорды)?

write(f,b[i]); в цикле? выдаёт ошибку

вообще вопрос не в этом - как записать информацию в конец файла?

то есть в файл как бы дописываются элементы, но при их выводе выводятся вместо текста - пустота, вместо цифр - нули.

program rec;
uses crt;
type
   TRec = record
      name       : string [31];
      result     : real;
      startnum   : integer;
   end;
   TBase = array [1..100] of TRec;
   TFile = file of TBase;




procedure Delete ( var b : TBase; var f : TFile; var k : integer)   ;
var
  i, g : byte;
  endv : integer;
begin
  read (f, b);
  endv := filesize(f)+1;
  For i := 1 to endv do if k = b[i].startnum then g := i;
  For i := g to (endv-1) do b[i] := b[i+1];
  endv  := endv-1;
  write(f, b);
  writeln('Sportsmen was successfully deleted.');
  write('Press any button for return to menu.');
  ReadKey;
end;




procedure Add (var b : TBase; var f : TFile; var k : integer);
var
  i, start, endv : byte;
  size           : longint;
begin
  read (f, b);
  size   := filesize(f);
  endv   := (size+k);
  close(f);
  rewrite(f);
  for i := 1 to endv do
    begin
    with b[i] do begin
     if i > size then begin
	  writeln('Chelovek N ' , i);
	  write('Name: '); readln(name);
	  write('Startnum: '); readln(startnum);
	  write('The result: '); readln(result);
     end;
    end;
	write(f, b);
    writeln;
    end;
   write('Press any button for return to menu.');
   ReadKey;
end;




procedure ShowInfo (var b : TBase; var f : TFile);
var
  i : byte;
  min, max   : real;
  mini, maxi : integer;
begin
   read(f, b);
   writeln('Infromation about mans : ');
   for i := 1 to (FileSize(f)+1) do
    with b[i] do begin
	maxi := 1;
	mini := 1;
	min  := 0;
	max  := 0;
	if min < result then
	 begin
	  min  := result;
	  mini := i;
	end;
	if max > result then
	 begin
	  max  := result;
	  maxi := i;
	end;
    end;
    if mini = maxi then
     begin
      writeln('oops! ' , b[mini].name , ' is first and last at the same time!');
     end
    else
     begin
      writeln('First is ' , b[mini].name , ' in time ' , b[mini].result:6:3 , '!');
      writeln('Last is ' , b[maxi].name , ' in time ' , b[maxi].result:6:3 , '!');
     end;
   write('Press any button for return to menu.');
   ReadKey;
end;




procedure Input(var b : TBase; var f : TFile; var k : integer);
var
   i : byte;
begin
  writeln('Creating database. ');writeln;writeln;
  writeln('If sportsmen does not take part in competitions write 0 in "Result" field.');
   for i := 1 to k do
    with b[i] do begin
       writeln('Man N ',i);
       write('Name: '); readln(name);
       write('Startnum: '); readln(startnum);
       write('The result: '); readln(result);
       writeln;
    end;
   write(f, b);
   write('Press any button for return to menu.');
   ReadKey;
end;




procedure Print(var b : TBase; var f : TFile);
var
   i : byte;
begin
   read(f, b);
   writeln('Infromation about mans : ');
   while NOT EOF(f) begin
    with b[i] do begin
       writeln('Name: ' , name);
       writeln('Startnum: ' , startnum , ';');
       writeln('Result: ' , result:6:3 , ';');
       writeln;
    end;
   write('Press any button for return to menu.');
   ReadKey;
end;





var
   base     : TBase;
   baseFile : TFile;
   birthYr  : integer;
   temp     : integer;
   k        : integer;
begin
 CLRSCR;
 temp := -1;
 assign(baseFile, 'c:\students.db');
while temp <> 0 do
 begin
  CLRSCR;
  writeln('1 - create database(rewrite file);');
  writeln('2 - first and last sportsmen;');
  writeln('3 - prints database;');
  writeln('4 - add information in database;');
  writeln('5 - edit info;');
  writeln('6 - delete information from DB;');
  writeln('0 - exit.');
  readln(temp);

  if temp = 1 then
   begin
    rewrite(baseFile);
    Write('Enter count of rows for file: '); Readln(k);
    Input(base, baseFile, k);
    close(baseFile);
   end;

  if temp = 2 then
   begin
    reset(baseFile);
    ShowInfo(base, baseFile);
    close(baseFile);
   end;

  if temp = 3 then
   begin
    reset(baseFile);
    Print(base, baseFile);
    close(baseFile);
   end;

   if temp = 4 then
    begin
     reset(baseFile);
     write('How many rows you want to add in database? '); readln(k);
     Add(base, baseFile, k);
     close(baseFile);
    end;

   if temp = 6 then
    begin
     reset(baseFile);
     write('Enter number of deleting sportsmen: '); readln(k);
     Delete(base, baseFile, k);
     close(baseFile);
    end;
 end;
 writeln('Press any button for exit ...');
 ReadKey
end.

мисс_граффити

5.05.2007 21:58

Зачем

   TBase = array [1..100] of TRec;
   TFile = file of TBase;

?
Почему нельзя сделать

 TFile = file of TRec;

?

а вообще - добавь в ShowInfo первой строчкой reset(f)
или seek(f,0)

iSlayter

5.05.2007 22:02

Цитата(мисс_граффити @ 5.05.2007 18:58)

Зачем

   TBase = array [1..100] of TRec;
   TFile = file of TBase;

?
Почему нельзя сделать

 TFile = file of TRec;

?

а вообще - добавь в ShowInfo первой строчкой reset(f)
или seek(f,0)

Reset делается в самой программе

   begin
	reset(baseFile);
	ShowInfo(base, baseFile);
	close(baseFile);
   end;

при добавлении ничего не изменяется. процедура вывода файла не ShowInfo, а Print.
Делаю так, потому что так сделано в FAQ. Теперь если где-то, что-то изменить вылезает целая куча конфликтов типов

volvo

5.05.2007 22:09

Цитата

Делаю так, потому что так сделано в FAQ.

Ссылку в студию...

iSlayter

5.05.2007 22:10

Цитата(volvo @ 5.05.2007 19:09)

Ссылку в студию...

Записи. Record.

мисс_граффити

5.05.2007 22:29

procedure Add (var b : TBase; var f : TFile; var k : integer);
var
  i, start, endv : byte;
  size           : longint;
begin
  read (f, b);
  size   := filesize(f);
  endv   := (size+k);
  close(f);
  rewrite(f);
  for i := 1 to endv do
    begin
    with b[i] do begin
     if i > size then begin
	  writeln('Chelovek N ' , i);
	  write('Name: '); readln(name);
	  write('Startnum: '); readln(startnum);
	  write('The result: '); readln(result);
     end;
    end;
    seek(f,0); {!!!}
	write(f, b);
    writeln;
    end;
   write('Press any button for return to menu.');
   ReadKey;
end;

попробуй так

хотя filesize у тебя всегда будет возвращать 1... зачем ты им пользуешься?

iSlayter

6.05.2007 16:13

Всем огромное спасибо! В результате мною было принято решение переписать программу полностью!

program rec;
Uses crt;
type trec = record
	 name     : string[50];
	 startnum : integer;
	 result   : real;
end;
frec = file of trec;
var
   f       : frec;
   temp, k : integer;

procedure Add (var f1: frec; num: integer);
var
   r   : trec;
   k,i : integer;
begin
   CLRSCR;
   Reset (f1);
   k := FileSize (f1);
   Seek (f1, k);
   for i := 1 to num do
    begin
     with r do
      begin
	Write ('Name: '); readln (name);
	Write ('Start number: '); readln (startnum);
	Write ('Result: '); readln (result);
	Write (f1, r);
	Writeln;
      end
    end;
   Close (f1);
   Writeln ('Press any key ...');
   ReadKey;
end;


procedure Input (var f1: frec; num: integer);
var
   r   : trec;
   k,i : integer;
begin
   CLRSCR;
   ReWrite (f1);
   for i := 1 to num do
     with r do
       begin
	Write ('Name: '); readln (name);
	Write ('Start number: '); readln (startnum);
	Write ('Result: '); readln (result);
	Write (f1, r);
	k := k + 1;
       end;
   Close (f1);
end;

procedure Print (var f1: frec);
var
   r: trec;
   k: integer;
begin
   CLRSCR;
   Reset (f1);
   while NOT EOF (f1) do
    begin
     Read (f1, r);
     with r do
      begin
       Writeln ('Name: ' , name);
       Writeln ('Start number: ' , startnum);
       Writeln ('Result: ' , result:6:3);
       Writeln;
      end;
    end;
   close (f1); writeln;
   Writeln ('Press any key ...');
   ReadKey;
end;

procedure Delete (var f1: frec; num: integer);
var
   r        : trec;
   i, fsize : integer;
   tempfile : frec;
begin
   Assign (tempfile, 'c:\temp.db');
   ReWrite (tempfile);
   Reset (f1);
   While NOT EOF(f1) do
   begin
    Read (f1, r);
    if r.startnum <> num then
     begin
      Write (tempfile, r);
     end;
   end;
   Close (f1);   Close (tempfile);
   ReWrite (f1); Reset (tempfile);
   fsize := FileSize (tempfile);
   for i := 1 to fsize do
    begin
     Read (tempfile, r);
     Write (f1, r);
    end;
   Close (f1);   Close (tempfile);
   Writeln ('Sportsmen was successfully deleted! Now press any key ...');
   ReadKey;
end;

procedure Top (var f1: frec);
var
   r,rmax,rmin : trec;
   max,min     : real;
   i           : integer;
begin
   CLRSCR;
   Reset (f1);
   min :=  99999;
   max := -99999;
   While NOT EOF(f1) do
    begin
     Read (f1 ,r);
       if r.result > max then
	begin
	 rmax.name     := r.name;
	 rmax.startnum := r.startnum;
	 rmax.result   := r.result;
	 max := rmax.result;
	end;
       if r.result < min then
	begin
	 rmin.name     := r.name;
	 rmin.startnum := r.startnum;
	 rmin.result   := r.result;
	 min := rmin.result;
	end
    end;
   if rmin.startnum = rmax.startnum then
    begin
     Writeln ('Oops! The first and the last is at the same time ' , rmin.name , ' with:');
     Writeln ('Start number: ' , rmin.startnum , ';');
     Writeln ('Result: ' , rmin.result:6:3 , '.');
    end
   else
    begin
     Writeln ('First was ' , rmin.name , ' with: ');
     Writeln ('Start number: ' , rmin.startnum , ';');
     Writeln ('Result: ' , rmin.result:6:3 , '.');
     Writeln; Writeln;
     Writeln ('Last was ' , rmax.name , ' with: ');
     Writeln ('Start number: ' , rmax.startnum , ';');
     Writeln ('Result: ' , rmax.result:6:3 , '.');
    end;
   Close (f1);
   Writeln ('Now press any key ...');
   ReadKey;
end;

procedure Edit (var f1: frec; num: integer);
var
   r        : trec;
   i, fsize : integer;
   tempfile : frec;
begin
   CLRSCR;
   Assign (tempfile, 'c:\temp.db');
   ReWrite (tempfile);
   Reset (f1);
   While NOT EOF(f1) do
   begin
    Read (f1, r);
    if r.startnum <> num then
     begin
      Write (tempfile, r);
     end
    else
     begin
      Writeln ('Redaktirovanie sportsmena with start number "' , num , '":');
      Writeln;
      Write ('Name: '); Readln(r.name);
      Write ('Start number: '); Readln(r.startnum);
      Write ('Result: '); Readln(r.result);
      write (tempfile, r);
      Writeln;
     end
   end;
   Close (f1);   Close (tempfile);
   ReWrite (f1); Reset (tempfile);
   fsize := FileSize (tempfile);
   for i := 1 to fsize do
    begin
     Read (tempfile, r);
     Write (f1, r);
    end;
   Close (f1);   Close (tempfile);
   Writeln ('Sportsmen was successfully edited! Now press any key ...');
   ReadKey;
end;


begin
 temp := -1;
 assign (f, 'c:\students.db');
 while temp <> 0 do
  begin
   clrscr;
   Writeln ('1 - create database;');
   Writeln ('2 - print database;');
   Writeln ('3 - add record;');
   Writeln ('4 - delete record;');
   Writeln ('5 - view first and last sportsmen;');
   Writeln ('6 - edit sportsmen;');
   Writeln ('0 - exit from program;');
   Write ('Operation: ');
   Readln (temp);

   if temp = 1 then
    begin
     Write ('How many rows database must have? '); readln (k);
     Input (f, k);
    end;

    if temp = 2 then
    begin
     Print (f);
    end;

    if temp = 3 then
    begin
     Write ('How many records you wish to add? '); readln (k);
     Add (f, k);
    end;

    if temp = 4 then
    begin
     Write ('Enter start number of deleting sportsmen: '); read (k);
     Delete (f, k);
    end;


    if temp = 5 then
    begin
     Top (f);
    end;

    if temp = 6 then
    begin
     Write ('Enter start number of editing sportsmen: '); readln (k);
     Edit (f, k);
    end;
  end
end.

Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.