В этом коде определенно есть ошибка! Опции

[iSlayter]

Проблема в том, что в файле после его заполнения есть данные, а процедуры 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.

[iSlayter]

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

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.

Сообщение отредактировано: iSlayter - 6.05.2007 16:53