Народ помогите. Есть 2 файла 1 и 2, в 1-ом файле содержатся записи о книгах:

book= record
  cod:integer;{шифр книги}
  title:integer;{название книги}
  ekz:byte;{кол-во книг в каталоге}
end;

В файле 2 - запись об абонементах:

man=record
  ncb:integer; {номер читательского билета}
  {книги находящиеся у абонемента от 1 до 20 книг}
  k:array[1..20] of atribut;

запись atribut выглядит так:

atribut=record
  shifr:integer;
  when:integer;
  dowhen:integer;
end;

Вопрос! Когда абонемент берет книгу то должны вносится изменения в запись book (файл №1). Изменяется кол-во книг текущей книги book.ekz.
И шифр книги cod добавляется в запись man.k[i].shifr ... Как внести изменения в существующую запись (запись находится в файле)?

А ты уже нашел запись, которую нужно менять, или нужно ее найти и изменить?

Я нашел запись. Лучше покажу, вот эта процедура которая производит операцию выдача книг

procedure vidacha;
var
   name,shif,o:integer;
   ntitle,navtor:string;
begin
  writeln('Введите номер Ч/б '); readln(name);
  writeln('Введите название книги'); readln(ntitle);
  writeln('Введите автора книги'); readln(navtor);
  clrscr;
  reset(A);
  reset(f); 
  while (not eof(a)) and (not eof(f)) do begin
    read(a,man);
    read(f,book);
    if (book.title=ntitle) and (book.avtor=navtor) then begin
      for o:=1 to 10 do begin
        if man.k[o].shifr=0 then begin
          {man.k[o].shifr нужно добавить  в  запись о абонементах } 
          man.k[o].shifr:=book.cod;
          {book.ekz нужно изменить ekz в существующей записи о книге }
          book.ekz:=book.ekz-1;
          readkey; exit;
        end;
      end;
    end;
  end;
  ReadKey; 
  close(A);
  close(f);
End;

Так вот после этого:

man.k[o].shifr:=book.cod;
book.ekz:=book.ekz-1;
...

в памяти все изменения уже произведены - осталось перенести их в файл. Для этого возвращаемся на 1 позицию в обоих файлах назад и пишем измененные переменные:

{ продолжаем: вместо readkey }
seek(a, filepos(a)-1); write(a, man);
seek(f, filepos(f)-1); write(f, book);
exit; { и выходим }

Большое спасибо Volvo!

Решил писать в эту же тему. Думаю у меня будет несколько вопросов. Начну с первого. Итак, процедура create, которая создаёт новый файл и спрашивает у пользователя сколько готовить записей и соответсвенно считывает все поля с клавиатуры. Предположим у нас запись состоит из двух полей, вот фрагмент кода:

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

В принципе - правильно, но есть кое-что "лишнее"...

...
for i:=0 to n do begin
  seek(f,i); { если файл только что был создан - это не нужно }
  ...
end;

Если убрать Seek то при записи в файл указатель будет перемещаться автоматически...

И второе - зачем делать

readln(X);
rec.B:=X;

когда можно прямо:

readln( rec.B );

volvo, спасибо.

Ну это я для наглядности написал, в программе у меня по другому. У меня procedure InputData(var Name : string; leng : integer; p:boolean);которая проверяет корректность ввода, и которую я вызываю для счтения поля с клавиатуры в следующем виде Inputdata(str,leng,false); возвращает значение str, которое я и присваиваю полю (rec.b:=str); leng в процедуре это допустимая длина поля, а p true/false в зависимости от типа конкретного поля.

Немного кода:

program ...
type rec=record;
       ...
       price:real;
       end;
...
procedure create(...);
var str1:real; sk:integer; str:string;
...
TextColor(green);
gotoxy(6,8); write('Price: ');
TextColor(red);
leng:=5;
Inputdata(str,leng,false);
val(str, str1,sk); {???}
rec.price:=str1;

Что в данном случае мы выполняем процедурой val?

Преобразуем строковое представление числа (хранящееся в типе String) в нормальное числовое (в тип Real), при этом позиция первого ошибочного символа возвращается через переменную Sk типа Integer :yes:

Подробней читай Turbo Pascal Help...

Подскажите как реализовать процедуру добавления новой записи. Не знаю как увеличить размер файла.

всмысле увеличить размер ?
забей туда что-нить

Seek(f, FileSize(f));
Write(f, ...)

suriv, я неправильно выразился. volvo, спасибо.

Очередной вопрос. Сейчас работаю над процедурой edit, которая будет редактировать поле в записи. Предполагается, что номер записи и название поля вводит пользователь. Проблема в том, чтобы выполнить защиту от ошибки ввода таким образом, чтобы при вводе названия поля считывалось действительно существующее название, а если была ошибка, то выдавалось бы сообщение о ней и программа продолжала работу. Вот что сделал я :

procedure Edit(...);
Type
  FieldName=(Date, Price);  {это названия двух полей из которых состоит запись}
var
   Name:FieldName;
   ...
begin
   ...
  
   repeat
   clrscr;
   write('vvedite nazvanie polja');
  {I-}
    read(name);
  {I+}
    if (ioresult<>0) write('oshibka takogo polja ne sushestvuet!'); 
   until(ioresult=0);
   ...

Вопрос достаточно ли это эффективный алгоритм и вообще будет ли он выполнять поставленную задачу?

Нет, не будет... Ты не можешь работать с названиями полей. Тем более, ты не можешь вводить нестандартные типы:

{$I-}
  read(name); { <--- здесь будет ошибка }
{$I+}

Ошибка - "Error 64: Cannot Read or Write variables of this type."
Единственное, что ты можешь сделать - это ввести названия полей как строки и проверять наличие того или иного поля...

Помогите разобраться с процедурой Delete, которая бы удаляла запись из файла. Если мы удаляем запись из середины файла, то остальные записи, которые распологались за удаляемой записью передвигались на одну позицию влево (в файле) таким образом освободится одно место для записи в конце файла, его тоже требуется удалить, тем самым уменьшив размер файла.

type
  telement = record ... end;
  filetype = file of telement;

{ в процедуру передавай номер элемента, который надо удалить (с нулевого) }
procedure delete_record(var f: filetype; pos: longint);
var 
  x: telement;
  i: longint;
begin
  for i := pos to filesize(f) - 2 do begin
    { указатель - на следующий элемент файла и чтение }
    seek(f, i + 1); read(f, x);
    { указатель - на текущий элемент и запись }
    seek(f, i); write(f, x);
  end;
  { указатель - на предпоследний элемент }
  seek(f, filesize(f) - 1);
  truncate(f);
end;

Если же у тебя указатель уже стоит на том элементе, который надо удалить, то перед циклом можешь просто поставить

pos := filepos(f);

Начал отладку программы, появились некоторые проблемы.
1)

{редактирует запись, номер котрой вводит пользователь}
procedure FEdit(var f:filetype; var fileopen:boolean)
var
   i:integer; rec:DC  {DC - тип record}
begin
     write('Nomer zapisi: ');
      readln(i);
if (i<=filesize(f)) and (i>=1) then
    begin
       seek(f,i-1);

      {gotoxy(6,5); write('A:', rec.A, ' ');
      {тут должен происходить вывод всех полей в редактируемой записи}

      gotoxy(6,6); write('B:', rec.B, ' ');
      gotoxy(6,7); write('C:', rec.C, ' ');
      gotoxy(6,8); write('D:', rec.D, ' ');
      gotoxy(6,9); write('E:', rec.E, ' ');
      textcolor(white);
      gotoxy(10,10);
      write('(ENTER-Edit, ESC-Cancel)');
...
end;

И вместо того чтобы выводить нормально все поля в записи на экране появляется какая-то белеберда, в чём ошибка?
2)

{сортировать информацию по цене белета}
procedure FSortByPrice(var f:filetype);
var
 i, j:integer;
rec1, rec2, rec:DC;
begin
   for i:=0 to filesize(f)-1 do
    for j:=i+1 to filesize(f) do
     seek(f,i); write(f,rec1);
     seek(f,j); write(f,rec2);
     if (rec1.cena<rec2.cena) then
          begin
             rec:=rec1;
             rec1:=rec2;
             rec2:=rec;
             read(f,rec1);     {неуверен, что надо так}
             read(f,rec2);     {неуверен, что надо так}
          end;
.....
{вывод содержимого файла на экран в отсортированном виде}
for i:=1 to filesize(f) do  
     begin
      seek(f,i-1);
      read(f,rec);
    textcolor(green);
    gotoxy(1, 4+i);
    ClrEol;
    gotoxy(1, 4+i); write(i:2,'. ');
    gotoxy(6, 4+i); write(rec.Izbrauc);
    gotoxy(16, 4+i); write(rec.No);
    gotoxy(30, 4+i); write(rec.Iebrauc);
    gotoxy(38, 4+i); write(rec.Uz);
    gotoxy(44, 4+i); write(rec.cena:5:2);
  end;
  readkey;
end;

опять же при выводе на экран выводится белеберда и ещё по-моему добовляются лишние записи.
3)

{найти информацию по указанному полю}
procedure FFind(var f:filetype);
var i:integer;
    rec:DC; str:string;
begin
     write('Vvedite nazvanie knigi:             ');
     readln(str);
....
i:=0;

  for i:=0 to filesize(f) do
   seek(f,i); read(f,rec);{Error 100: Disk read error}
  if rec.A=str  then   {сравниваем информацию в поле А с введённой}
    begin                   {если поля совпадают выводим на экран запись}
    gotoxy(1, 9+i);
    ClrEol;
    gotoxy(1, 9+i);
    write(i:2,'. ');
    gotoxy(7, 9+i);
    write(rec.A);
    gotoxy(22, 9+i);
    write(rec.B);
    gotoxy(37, 9+i);
    write(rec.C);
    gotoxy(61, 9+i);
    write(rec.D);
    gotoxy(72, 9+i);
    write(rec.E);
    end;
  ReadKey;
end;

Почему выводится ошибка считывания с диска?

...
seek(f,i-1);
read(f, rec); { <--- Это что, не нужно? }
...

2.

procedure FSortByPrice(var f:filetype);
var 
  i, j:integer;
  rec1, rec2:DC;
begin
  for i:=0 to filesize(f)-1 do
    for j:=i+1 to filesize(f) do begin { <--- Begin обязательно !!! }
      seek(f,i); read(f,rec1); { Читаем, а не пишем !!! }
      seek(f,j); read(f,rec2);
      if (rec1.cena<rec2.cena) then begin
        seek(f,j); write(f,rec1);
        seek(f,i); write(f,rec2); { меняем местами }
        { в противном случае - ничего делать не надо: записи остаются на своих местах }
      end;
    end; { for }
...

3.

procedure FFind(var f:filetype);
...
begin
  for i:=0 to filesize(f - 1) do { не до последней, а до предпоследней записи }
...

А можно поинтересоваться, почему до предпоследней?

procedure FSortByPrice(var f:filetype);
var 
  i, j:integer;
  rec1, rec2:DC;
begin
  for i:=0 to filesize(f)-1 do
    for j:=i+1 to filesize(f) do begin 
      seek(f,i); read(f,rec1);
       seek(f,j); read(f,rec2); {тут выдаёт ошибку Error 100: Disk read error}
      if (rec1.cena<rec2.cena) then begin
        seek(f,j); write(f,rec1);
        seek(f,i); write(f,rec2); { меняем местами }
        { в противном случае - ничего делать не надо: записи остаются на своих местах }
      end;
    end; { for }
...

Остальное всё подправил, вроде работает volvo, спасибо!

Потому что

seek(f, filesize(f));

означает "переместить указатель файла ЗА последнюю запись" - это обычно делается для добавления в конец файла. Не забывай, что у тебя нумерация записей в файле начинается с 0, и чтобы обратиться к записи №3 (№3 для тебя, начиная с 1-цы), тебе нужно сделать

seek(f, 2);

Если же ты сделаешь seek(f, 3); то будешь добавлять 4-ю запись (это допустимо), или читать 4-ю (а вот это и есть Error 100)...

2.

procedure FSortByPrice(var f:filetype);
...
  for i:=0 to pred(filesize(f)-1) do { причина - выше }
    for j:=i+1 to pred(filesize(f)) do begin
    ...
    end; { for }
...

Всё вроде разобрался, программа раюотает! volvo, огромное спасибо за помощь!!! Респект!!! :flowers: