IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> В этом коде определенно есть ошибка!
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 11
Пол: Мужской
Реальное имя: Юрий

Репутация: -  0  +


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


Гость






Цитата
а процедуры 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 ...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Ищущий истину
******

Группа: Пользователи
Сообщений: 4 825
Пол: Мужской
Реальное имя: Олег

Репутация: -  45  +


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


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Новичок
*

Группа: Пользователи
Сообщений: 11
Пол: Мужской
Реальное имя: Юрий

Репутация: -  0  +


Цитата(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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Новичок
*

Группа: Пользователи
Сообщений: 11
Пол: Мужской
Реальное имя: Юрий

Репутация: -  0  +


кто-нибудь, помогите разобраться! smile.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Новичок
*

Группа: Пользователи
Сообщений: 11
Пол: Мужской
Реальное имя: Юрий

Репутация: -  0  +


up! ещё актуально!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


просто человек
******

Группа: Пользователи
Сообщений: 3 641
Пол: Женский
Реальное имя: Юлия

Репутация: -  55  +


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


--------------------
Все содержимое данного сообщения (кроме цитат) является моим личным скромным мнением и на статус истины в высшей инстанции не претендует.
На вопросы по программированию, физике, математике и т.д. в аське и личке не отвечаю. Даже "один-единственный раз" в виде исключения!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Новичок
*

Группа: Пользователи
Сообщений: 11
Пол: Мужской
Реальное имя: Юрий

Репутация: -  0  +


Цитата(мисс_граффити @ 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.


Сообщение отредактировано: iSlayter -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


просто человек
******

Группа: Пользователи
Сообщений: 3 641
Пол: Женский
Реальное имя: Юлия

Репутация: -  55  +


Зачем
   TBase = array [1..100] of TRec;
   TFile = file of TBase;
?
Почему нельзя сделать
 TFile = file of TRec;
?

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


--------------------
Все содержимое данного сообщения (кроме цитат) является моим личным скромным мнением и на статус истины в высшей инстанции не претендует.
На вопросы по программированию, физике, математике и т.д. в аське и личке не отвечаю. Даже "один-единственный раз" в виде исключения!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Новичок
*

Группа: Пользователи
Сообщений: 11
Пол: Мужской
Реальное имя: Юрий

Репутация: -  0  +


Цитата(мисс_граффити @ 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

Сообщение отредактировано: iSlayter -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Гость






Цитата
Делаю так, потому что так сделано в FAQ.
Ссылку в студию...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Новичок
*

Группа: Пользователи
Сообщений: 11
Пол: Мужской
Реальное имя: Юрий

Репутация: -  0  +


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

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

Записи. Record.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


просто человек
******

Группа: Пользователи
Сообщений: 3 641
Пол: Женский
Реальное имя: Юлия

Репутация: -  55  +


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... зачем ты им пользуешься?


--------------------
Все содержимое данного сообщения (кроме цитат) является моим личным скромным мнением и на статус истины в высшей инстанции не претендует.
На вопросы по программированию, физике, математике и т.д. в аське и личке не отвечаю. Даже "один-единственный раз" в виде исключения!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #14


Новичок
*

Группа: Пользователи
Сообщений: 11
Пол: Мужской
Реальное имя: Юрий

Репутация: -  0  +


Всем огромное спасибо! В результате мною было принято решение переписать программу полностью! 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.


Сообщение отредактировано: iSlayter -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 13.01.2025 9:52
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name