1. Заголовок или название темы должно быть информативным ! 2. Все тексты фрагментов программ должны помещаться в теги [code] ... [/code] или [code=pas] ... [/code]. 3. Прежде чем задавать вопрос, см. "FAQ" и используйте ПОИСК ! 4.НЕ используйте форум для личного общения! 5. Самое главное - это раздел теоретический, т.е. никаких задач и программ (за исключением небольших фрагментов) - для этого есть отдельный раздел!
Вопрос! Когда абонемент берет книгу то должны вносится изменения в запись 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;
в памяти все изменения уже произведены - осталось перенести их в файл. Для этого возвращаемся на 1 позицию в обоих файлах назад и пишем измененные переменные:
{ продолжаем: вместо readkey } seek(a, filepos(a)-1); write(a, man); seek(f, filepos(f)-1); write(f, book); exit; { и выходим }
Решил писать в эту же тему. Думаю у меня будет несколько вопросов. Начну с первого. Итак, процедура create, которая создаёт новый файл и спрашивает у пользователя сколько готовить записей и соответсвенно считывает все поля с клавиатуры. Предположим у нас запись состоит из двух полей, вот фрагмент кода:
Код
writeln('skolko zapisej gotovitj v novom faile?'); readln(n); ... for i:=0 to n do begin seek(f,i); clrscr; gotoxy(8,3); write('zapisj Nr:',i+1); gotoxy(6,4); write('A:'); {первое поле} ... {ввод поля А с клавиатуры} readln(X); rec.A:=X; gotoxy(6,5); write('B:'); ...{ввод поля В} readln(X); rec.B:=X; write(f,rec); write('to continue press any key); readkey; end; ...
Вопрос правильно ли я всё написал, те ли операторы использовал, будет ли моя задумка реализована?
Ну это я для наглядности написал, в программе у меня по другому. У меня 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;
Преобразуем строковое представление числа (хранящееся в типе String) в нормальное числовое (в тип Real), при этом позиция первого ошибочного символа возвращается через переменную Sk типа Integer :yes:
Cмотри,а то ведь получишь! Админ. Не получит - его фиг догонишь! Админ №2. P.S Вы еще третьего админа притащите сюда :D ваш аффтар :D Звали? :D (админ № не помню какой) ха больше нифига не напишете афтар Уверен? (Moderator) А еще можно ? (супмодер) Хватит его мучать ! Избили уж... (админ) Не хватит. я тоже напишу (тоже Админ)
Очередной вопрос. Сейчас работаю над процедурой 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;
Если же у тебя указатель уже стоит на том элементе, который надо удалить, то перед циклом можешь просто поставить
Начал отладку программы, появились некоторые проблемы. 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, ' '); {тут должен происходить вывод всех полей в редактируемой записи}
И вместо того чтобы выводить нормально все поля в записи на экране появляется какая-то белеберда, в чём ошибка? 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 { не до последней, а до предпоследней записи } ...