Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

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

Автор: 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, а почему вы не используете отладчик?
Вопрос не возник бы...

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

Прошу посмотреть в последний раз, честное слово!
Всё переписал немного. Ну и это уже для другого человека лаба.
Вообщем проблема такая - есть процедура записи новых рекордов в файл, и есть процедура удаления их из файла. Соответственно процедуры с именами 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

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

Автор: 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. Теперь если где-то, что-то изменить вылезает целая куча конфликтов типов sad.gif

Автор: volvo 5.05.2007 22:09

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

Автор: iSlayter 5.05.2007 22:10

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

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

http://forum.pascal.net.ru/index.php?showtopic=9198#

Автор: мисс_граффити 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

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

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.