 СЛОЖНАЯ ЗАДАЧА:Типизированные файлы-НУЖНА ПОМОЩЬ!, добавление записей, их сортировка и т.д. |
Прочтите прежде чем задавать вопрос!
1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!
  |
| LLIRIKS |
  19.12.2004 1:34
Сообщение
#1
|
|
Новичок  Группа: Пользователи Сообщений: 24 Пол: Мужской Репутация:  0   |
Плиз!
Помогите доделать до конца... 2/3 задачи уже решил - и застрял... в общем, вот она, задача: Цитата Подготовить список из N наименований товаров. Конкретное значение N указано в варианте. Информация о каждом товаре содержит: 1. Название товара. 2. Цену. 3. Год выпуска. 4. Количество. Список должен быть упорядочен по одному из параметров, указанных в конкретном варианте. Сведения по каждому товару необходимо представить в виде записи. Разработать программу, которая заносит во внешний файл записи упорядоченного списка, и программу, которая добавляет в сформированный внешний файл данные об М товарах, при этом, не нарушая упорядоченности исходного файла. Если среди добавляемых товаров встречается товар, сведения о котором в файле уже есть, то необходимо их обновить, т. е. старую запись исключить. Варианты задания 7. Товары упорядочены по неубыванию цены, N=13, М=4. Не могу воплотить в жизнь последний этап задачи, т.е. добавлять в файл записи, не нарушая при этом упорядоченности файла и обновляя информацию об уже существующих товарах... Вот что у меня пока получилось: Исходный код uses crt; type TOVAR=record NAZV:string; ZENA:integer; GOD_VIP:integer; KOL:integer; end; const N=13; M=4; var F1,F2:file of TOVAR; S1,S2:TOVAR; I,K,J:integer; begin {################################-VVOD_DANNIH-##############################} assign(F1,'tovary.dat'); rewrite(F1); for I:=1 to N do begin with S1 do begin clrscr; writeln; writeln('-------------------------------------------------------'); writeln('Vvedite dannie ',I,'-go tovara:'); writeln('-------------------------------------------------------'); writeln('Vvedite nazvanie:'); readln(NAZV); writeln('Vvedite zenu:'); readln(ZENA); writeln('Vvedite god vipuska:'); readln(GOD_VIP); writeln('Vvedite kolichestvo:'); readln(KOL); end; write(F1,S1); end; close(F1); {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@-SORTIROVKA-@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@} assign(F1,'tovary.dat'); reset(F1); K:=filesize(F1); seek(F1,0); for I:=K-1 downto 1 do for J:=1 to K-2 do begin seek(F1,J); read(F1,S1); seek(F1,J+1); read(F1,S2); if S1.ZENA>S2.ZENA then begin seek(F1,J); write(F1,S2); seek(F1,J+1); write(F1,S1); end; end; close(F1); {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@-VIVOD_DANNIH_1-@@@@@@@@@@@@@@@@@@@@@@@@@@@@} assign(F1,'tovary.dat'); reset(F1); clrscr; I:=1; while (not EOF(F1)) do begin read(F1,S1); with S1 do begin writeln; writeln('-------------------------------------------------------'); writeln('Dannie ',I,'-go tovara:'); writeln('-------------------------------------------------------'); writeln('Nazvanie: ',NAZV); writeln('Zena: ',ZENA); writeln('God vipuska: ',GOD_VIP); writeln('Kolichestvo: ',KOL); Inc(I); end; end; close(F1); {###########-DOBAVLENIE_DANNIH_BEZ_NARUSHENIYA_UPORYADOCHENNOSTI-###########} {ВОТ ЗДЕСЬ-ТО Я И НЕ ЗНАЮ, ЧТО ДЕЛАТЬ...} end. сложность состоит в том, что в файл нужно добавлять новые записи уже в нужное место... МОЖЕТ, МОЖНО КАК-НИБУДЬ РАЗДВИНУТЬ ЗАПИСИ В ФАЙЛЕ И МЕЖДУ НИМИ ВСТАВИТЬ НОВУЮ ЗАПИСЬ? -------------------- Я не люблю, когда мне лезут в душу,
Тем более, когда в нее плюют... |
   |
 
|
| volvo |
19.12.2004 2:04
Сообщение
#2
|
|
Гость |
Ты имеешь в виду это?
Код ... fp := filepos(f); { запоминаешь текущую позицию в файле } seek(f, filesize(f)); { пишешь в файл пустую структуру (просто, чтобы увеличить количество записей в файле) } for curr := filesize(f)-1 downto fp+1 do begin seek(f, curr - 1); read(f, rec); seek(f, curr); write(f, rec); end; { когда придешь сюда, все записи после той, куда надо записать новую, будут сдвинуты к концу файла. } |
|
|
|
| LLIRIKS |
19.12.2004 2:30
Сообщение
#3
|
|
Новичок Группа: Пользователи Сообщений: 24 Пол: Мужской Репутация: 0 |
ОГРОМНОЕ СТУДЕНЧЕСКОЕ СПАСИБО!
дальше уже все просто... P.S.: Вот, значит, где собака порылась... ;) -------------------- Я не люблю, когда мне лезут в душу,
Тем более, когда в нее плюют... |
|
|
|
| LLIRIKS |
19.12.2004 3:46
Сообщение
#4
|
|
Новичок Группа: Пользователи Сообщений: 24 Пол: Мужской Репутация: 0 |
Хотя нет... вру...
возникает еще вот такая проблема: Код {###########-DOBAVLENIE_DANNIH_BEZ_NARUSHENIYA_UPORYADOCHENNOSTI-###########} assign(F1,'tovary.dat'); reset(F1); for I:=1 to M do begin with S1 do begin clrscr; writeln; writeln('-------------------------------------------------------'); writeln('Vvedite dannie ',I,'-go tovara:'); writeln('-------------------------------------------------------'); writeln('Vvedite nazvanie:'); readln(NAZV); writeln('Vvedite zenu:'); readln(ZENA); writeln('Vvedite god vipuska:'); readln(GOD_VIP); writeln('Vvedite kolichestvo:'); readln(KOL); end; L:=filesize(F1); seek(F1,0); for J:=1 to L do begin read(F1,S2); if S2.NAZV=S1.NAZV then begin {ОБНОВЛЕНИЕ ЗАПИСИ: НУЖНО УДАЛИТЬ СТАРУЮ ЗАПИСЬ, А НОВУЮ ПРИТКНУТЬ В ДРУГОЕ МЕСТО, ТАК ЧТОБЫ ЦЕНЫ БЫЛИ УПОРЯДОЧЕНЫ ПО ВОЗРАСТАНИЮ...} end; if (S2.ZENA>S1.ZENA) begin fp:=filepos(F1); {освобождаем позицию fp-1 сдвигом, записываем S1 в освободившуюся запись} J:=L+1; end; if (J:=L) and (S1.ZENA>S2.ZENA) then write(F1,S1); end; end; close(F1); так вот в чем проблема: надо удалить запись из файла, не создавая нового файла... а без работы с указателями и динамической памятью это реально организовать? -------------------- Я не люблю, когда мне лезут в душу,
Тем более, когда в нее плюют... |
|
|
|
| volvo |
19.12.2004 11:08
Сообщение
#5
|
|
Гость |
LLIRIKS
А тем же самым способом, что я описал выше, перенести ненужную запись в самый конец файла, а потом отсечь ее с помощью Truncate, не догадался? |
|
|
|
| LLIRIKS |
19.12.2004 13:54
Сообщение
#6
|
|
Новичок Группа: Пользователи Сообщений: 24 Пол: Мужской Репутация: 0 |
Цитата(volvo @ 19.12.04 11:08) LLIRIKS А тем же самым способом, что я описал выше, перенести ненужную запись в самый конец файла, а потом отсечь ее с помощью Truncate, не догадался? А можно поподробней?  -------------------- Я не люблю, когда мне лезут в душу,
Тем более, когда в нее плюют... |
|
|
|
| volvo |
19.12.2004 14:29
Сообщение
#7
|
|
Гость |
fp := filepos(f); { запоминаешь текущую позицию в файле }
{ переписываешь все последующие на одну назад, при этом
ненужная запись будет перезаписана следующей по порядку,
и т.д., а последняя будет дублировать предпоследнюю}
for curr := fp to filesize(f) - 2 do
begin
seek(f, curr+1); read(f, rec);
seek(f, curr); write(f, rec);
end;
seek(f, filesize(f) - 1);
truncate(f); {отсекаешь последнюю запись}
|
|
|
|
| LLIRIKS |
19.12.2004 15:10
Сообщение
#8
|
|
Новичок Группа: Пользователи Сообщений: 24 Пол: Мужской Репутация: 0 |
а почему curr:=filesize(f)-1 ?
здесь ведь указатель должен быть в конце файла, разве не так? если не сложно, объясните, когда и в каких местах указатели... -------------------- Я не люблю, когда мне лезут в душу,
Тем более, когда в нее плюют... |
|
|
|
| volvo |
19.12.2004 15:29
Сообщение
#9
|
|
Гость |
LLIRIKS
Ты не понял, я не привел саму запись пустой структуры, я привел пример, как, после того, как размер файла увеличен, перекинуть нужные записи на 1 ближе к концу файла, и тем самым освободить место для вставки новой записи в середину файла. P.S. А начинаем с Код curr:=filesize(f)-1 , потому, что если мы начнем с curr:=filesize(f), то при seek(f, curr); write(f, rec); мы не переместим запись, а добавим еще одну запись к файлу.В общем случае, для добавления новой записи к файлу нужно делать: seek(f, filesize(f)), а для перезаписи последней компоненты: seek(f, filesize(f)-1). |
|
|
|
| LLIRIKS |
19.12.2004 16:50
Сообщение
#10
|
|
Новичок Группа: Пользователи Сообщений: 24 Пол: Мужской Репутация: 0 |
вот, написал:
uses crt;
type TOVAR=record
NAZV:string;
ZENA:integer;
GOD_VIP:integer;
KOL:integer;
end;
const N=13;
M=4;
var F1,F2:file of TOVAR;
S1,S2,S3:TOVAR;
I,K,L,J,fp:integer;
begin
{################################-ВВОД_ДАННЫХ-##############################}
assign(F1,'tovary.dat');
rewrite(F1);
for I:=1 to N do
begin
with S1 do
begin
clrscr;
writeln;
writeln('-------------------------------------------------------');
writeln('Введите данные ',I,'-го товара:');
writeln('-------------------------------------------------------');
writeln('Введите название:');
readln(NAZV);
writeln('Введите цену:');
readln(ZENA);
writeln('Введите год выпуска:');
readln(GOD_VIP);
writeln('Введите количество:');
readln(KOL);
end;
write(F1,S1);
end;
close(F1);
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@-СОРТИРОВКА-@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
assign(F1,'tovary.dat');
reset(F1);
K:=filesize(F1);
seek(F1,0);
for I:=K-1 downto 1 do
for J:=1 to K-2 do
begin
seek(F1,J);
read(F1,S1);
seek(F1,J+1);
read(F1,S2);
if S1.ZENA>S2.ZENA then
begin
seek(F1,J);
write(F1,S2);
seek(F1,J+1);
write(F1,S1);
end;
end;
close(F1);
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@-ВЫВОД_ДАННЫХ-@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
assign(F1,'tovary.dat');
reset(F1);
clrscr;
I:=1;
while (not EOF(F1)) do
begin
read(F1,S1);
with S1 do
begin
writeln;
writeln('-------------------------------------------------------');
writeln('Данные ',I,'-го товара:');
writeln('-------------------------------------------------------');
writeln('Название: ',NAZV);
writeln('Цена: ',ZENA);
writeln('Год выпуска: ',GOD_VIP);
writeln('Количество: ',KOL);
Inc(I);
end;
end;
close(F1);
{###############-ДОБАВЛЕНИЕ_ДАННЫХ_БЕЗ_НАРУШЕНИЯ_УПОРЯДОЧЕННОСТИ-###########}
assign(F1,'tovary.dat');
reset(F1);
for I:=1 to M do
begin
with S1 do
begin
clrscr;
writeln;
writeln('-------------------------------------------------------');
writeln('Введите данные ',I,'-го товара:');
writeln('-------------------------------------------------------');
writeln('Введите название:');
readln(NAZV);
writeln('Введите цену:');
readln(ZENA);
writeln('Введите год выпуска:');
readln(GOD_VIP);
writeln('Введите количество:');
readln(KOL);
end;
L:=filesize(F1);
seek(F1,0);
for J:=0 to L do
begin
read(F1,S2);
if (S2.NAZV=S1.NAZV) then
begin
for K:=J to filesize(F1)-2 do
begin
seek(F1,K+1);read(F1,S3);
seek(F1,K);write(F1,S3);
end;
seek(F1,filesize(F1)-1);
truncate(F1);
end;
end;
L:=filesize(F1);
seek(F1,0);
for J:=0 to L do
begin
read(F1,S2);
if (S1.ZENA<S2.ZENA) then
begin
for K:=filesize(F1)-1 to J do
begin
seek(F1,K);read(F1,S3);
seek(F1,K+1);write(F1,S3);
end;
seek(F1,J);
write(F1,S1);
J:=L+1;
end;
if (J=L) and (S1.ZENA>S2.ZENA) then
begin
seek(F1,J+1);
write(F1,S1);
end;
end;
end;
close(F1);
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@-ВЫВОД_ДАННЫХ-@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
assign(F1,'tovary.dat');
reset(F1);
clrscr;
I:=1;
while (not EOF(F1)) do
begin
read(F1,S1);
with S1 do
begin
writeln;
writeln('-------------------------------------------------------');
writeln('Данные ',I,'-го товара:');
writeln('-------------------------------------------------------');
writeln('Название: ',NAZV);
writeln('Цена: ',ZENA);
writeln('Год выпуска: ',GOD_VIP);
writeln('Количество: ',KOL);
Inc(I);
end;
end;
close(F1);
end.
но не пашет - вылетает при добавлении новой записи без нарушения упорядоченности... показывает ошибку 100 - disk read error - вот на этой строчке:
L:=filesize(F1);
seek(F1,0);
for J:=0 to L do
begin
read(F1,S2); {ВОТ ЗДЕСЬ ВЫЛЕТАЕТ... ЧЕГО ЕЙ НЕ НРАВИТСЯ?!....}
if (S2.NAZV=S1.NAZV) then
begin
for K:=J to filesize(F1)-2 do
begin
seek(F1,K+1);read(F1,S3);
seek(F1,K);write(F1,S3);
end;
seek(F1,filesize(F1)-1);
truncate(F1);
end;
end;
-------------------- Я не люблю, когда мне лезут в душу,
Тем более, когда в нее плюют... |
|
|
|
| volvo |
19.12.2004 17:09
Сообщение
#11
|
|
Гость |
LLIRIKS
Ты просто пытаешься читать за концом файла: for J:=0 to L do
begin
read(F1,S2);
...
измени на for J:=0 to L-1 do {или for J := 1 to L do}
begin
read(F1,S2);
...
|
|
|
|
| LLIRIKS |
19.12.2004 17:29
Сообщение
#12
|
|
Новичок Группа: Пользователи Сообщений: 24 Пол: Мужской Репутация: 0 |
работает, но опять не до конца...
если добавлять записи с названием, которое уже есть - вылетает...  -------------------- Я не люблю, когда мне лезут в душу,
Тем более, когда в нее плюют... |
|
|
|
| LLIRIKS |
19.12.2004 19:51
Сообщение
#13
|
|
Новичок Группа: Пользователи Сообщений: 24 Пол: Мужской Репутация: 0 |
ПОМОГИТЕ, плиз!..
осталось совсем немного - исправить ошибку...  -------------------- Я не люблю, когда мне лезут в душу,
Тем более, когда в нее плюют... |
|
|
|
| volvo |
19.12.2004 20:00
Сообщение
#14
|
|
Гость |
LLIRIKS
Секунду, ты в 2-х местах поменял то, что я сказал? У тебя в программе есть 2 подобных цикла... for J:=0 to L do
begin...
|
|
|
|
| LLIRIKS |
19.12.2004 20:04
Сообщение
#15
|
|
Новичок Группа: Пользователи Сообщений: 24 Пол: Мужской Репутация: 0 |
Цитата(volvo @ 19.12.04 20:00) ты в 2-х местах поменял то, что я сказал? да...если добавлять записи с неповторяющимися названиями, то все путем - хотя нет, предпоследняя запись почему-то нулевая... а если добавляю запись с названием, которое уже есть в файле, то вылетает та же ошибка 100... уже весь алгоритм раз 200 просматривал, чего только не менял - все равно та же ошибка -------------------- Я не люблю, когда мне лезут в душу,
Тем более, когда в нее плюют... |
|
|
|
| LLIRIKS |
19.12.2004 20:23
Сообщение
#16
|
|
Новичок Группа: Пользователи Сообщений: 24 Пол: Мужской Репутация: 0 |
с нулевой записью я разобрался... фуф...
но вот 2-е ЕСЛИ ну никак не могу найти...  вот что у меня на данный момент:
uses crt;
type TOVAR=record
NAZV:string;
ZENA:integer;
GOD_VIP:integer;
KOL:integer;
end;
const N=13;
M=4;
var F1,F2:file of TOVAR;
S1,S2,S3:TOVAR;
I,K,L,J,fp:integer;
begin
{################################-ВВОД_ДАННЫХ-##############################}
assign(F1,'tovary.dat');
rewrite(F1);
for I:=1 to N do
begin
with S1 do
begin
clrscr;
writeln;
writeln('-------------------------------------------------------');
writeln('Введите данные ',I,'-го товара:');
writeln('-------------------------------------------------------');
writeln('Введите название:');
readln(NAZV);
writeln('Введите цену:');
readln(ZENA);
writeln('Введите год выпуска:');
readln(GOD_VIP);
writeln('Введите количество:');
readln(KOL);
end;
write(F1,S1);
end;
close(F1);
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@-СОРТИРОВКА-@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
assign(F1,'tovary.dat');
reset(F1);
K:=filesize(F1);
seek(F1,0);
for I:=K-1 downto 1 do
for J:=1 to K-2 do
begin
seek(F1,J);
read(F1,S1);
seek(F1,J+1);
read(F1,S2);
if S1.ZENA>S2.ZENA then
begin
seek(F1,J);
write(F1,S2);
seek(F1,J+1);
write(F1,S1);
end;
end;
close(F1);
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@-ВЫВОД_ДАННЫХ_1-@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
assign(F1,'tovary.dat');
reset(F1);
clrscr;
I:=1;
while (not EOF(F1)) do
begin
read(F1,S1);
with S1 do
begin
writeln;
writeln('-------------------------------------------------------');
writeln('Данные ',I,'-го товара:');
writeln('-------------------------------------------------------');
writeln('Название: ',NAZV);
writeln('Цена: ',ZENA);
writeln('Год выпуска: ',GOD_VIP);
writeln('Количество: ',KOL);
Inc(I);
end;
end;
close(F1);
{###############-ДОБАВЛЕНИЕ_ДАННЫХ_БЕЗ_НАРУШЕНИЯ_УПОРЯДОЧЕННОСТИ-###########}
assign(F1,'tovary.dat');
reset(F1);
for I:=1 to M do
begin
with S1 do
begin
clrscr;
writeln;
writeln('-------------------------------------------------------');
writeln('Введите данные ',I,'-го товара:');
writeln('-------------------------------------------------------');
writeln('Введите название:');
readln(NAZV);
writeln('Введите цену:');
readln(ZENA);
writeln('Введите год выпуска:');
readln(GOD_VIP);
writeln('Введите количество:');
readln(KOL);
end;
L:=filesize(F1);
seek(F1,0);
for J:=0 to L-1 do
begin
read(F1,S2);
if (S2.NAZV=S1.NAZV) then
begin
for K:=J to L-2 do
begin
seek(F1,K+1);read(F1,S3);
seek(F1,K);write(F1,S3);
end;
seek(F1,L-1);
truncate(F1);
end;
end;
L:=filesize(F1);
seek(F1,0);
for J:=0 to L-1 do
begin
read(F1,S2);
if (S1.ZENA<S2.ZENA) then
begin
for K:=L-1 to J do
begin
seek(F1,K);read(F1,S3);
seek(F1,K+1);write(F1,S3);
end;
seek(F1,J);
write(F1,S1);
J:=L+1;
end;
if (J=L-1) and (S1.ZENA>S2.ZENA) then
begin
seek(F1,J+1);
write(F1,S1);
end;
end;
end;
close(F1);
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@-ВЫВОД_ДАННЫХ-@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
assign(F1,'tovary.dat');
reset(F1);
clrscr;
I:=1;
while (not EOF(F1)) do
begin
read(F1,S1);
with S1 do
begin
writeln;
writeln('-------------------------------------------------------');
writeln('Данные ',I,'-го товара:');
writeln('-------------------------------------------------------');
writeln('Название: ',NAZV);
writeln('Цена: ',ZENA);
writeln('Год выпуска: ',GOD_VIP);
writeln('Количество: ',KOL);
Inc(I);
end;
end;
close(F1);
end.
где-то еще хромает логика... -------------------- Я не люблю, когда мне лезут в душу,
Тем более, когда в нее плюют... |
|
|
|
| LLIRIKS |
19.12.2004 21:54
Сообщение
#17
|
|
Новичок Группа: Пользователи Сообщений: 24 Пол: Мужской Репутация: 0 |
Выручайте, плз!
завтра уже сдавать... где у меня ошибки (кажется, их несколько) -------------------- Я не люблю, когда мне лезут в душу,
Тем более, когда в нее плюют... |
|
|
|
|
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0
|
Текстовая версия | 29.07.2025 4:36 |