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

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

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

 
 Ответить  Открыть новую тему 
> СЛОЖНАЯ ЗАДАЧА:Типизированные файлы-НУЖНА ПОМОЩЬ!, добавление записей, их сортировка и т.д.
сообщение
Сообщение #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.

сложность состоит в том, что в файл нужно добавлять новые записи уже в нужное место...
МОЖЕТ, МОЖНО КАК-НИБУДЬ РАЗДВИНУТЬ ЗАПИСИ В ФАЙЛЕ И МЕЖДУ НИМИ ВСТАВИТЬ НОВУЮ ЗАПИСЬ?


--------------------
Я не люблю, когда мне лезут в душу,
Тем более, когда в нее плюют...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #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;
{ когда придешь сюда, все записи после той, куда надо записать новую, будут сдвинуты к концу файла. }
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

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

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


ОГРОМНОЕ СТУДЕНЧЕСКОЕ СПАСИБО!
дальше уже все просто...
P.S.: Вот, значит, где собака порылась... ;)


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

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


--------------------
Я не люблю, когда мне лезут в душу,
Тем более, когда в нее плюют...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Гость






LLIRIKS
А тем же самым способом, что я описал выше, перенести ненужную запись в самый конец файла, а потом отсечь ее с помощью Truncate, не догадался?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Новичок
*

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

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


Цитата(volvo @ 19.12.04 11:08)
LLIRIKS
А тем же самым способом, что я описал выше, перенести ненужную запись в самый конец файла, а потом отсечь ее с помощью Truncate, не догадался?

А можно поподробней? unsure.gif


--------------------
Я не люблю, когда мне лезут в душу,
Тем более, когда в нее плюют...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #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); {отсекаешь последнюю запись}

 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Новичок
*

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

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


а почему curr:=filesize(f)-1 ?
здесь ведь указатель должен быть в конце файла, разве не так?
если не сложно, объясните, когда и в каких местах указатели...


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



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


Новичок
*

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

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


работает, но опять не до конца...
если добавлять записи с названием, которое уже есть - вылетает... sad.gif


--------------------
Я не люблю, когда мне лезут в душу,
Тем более, когда в нее плюют...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Новичок
*

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

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


ПОМОГИТЕ, плиз!..
осталось совсем немного - исправить ошибку...
blink.gif


--------------------
Я не люблю, когда мне лезут в душу,
Тем более, когда в нее плюют...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #14


Гость






LLIRIKS
Секунду, ты в 2-х местах поменял то, что я сказал? У тебя в программе есть 2 подобных цикла...
for J:=0 to L do
begin...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #15


Новичок
*

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

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


Цитата(volvo @ 19.12.04 20:00)
ты в 2-х местах поменял то, что я сказал?
да...
если добавлять записи с неповторяющимися названиями, то все путем - хотя нет, предпоследняя запись почему-то нулевая...
а если добавляю запись с названием, которое уже есть в файле, то вылетает та же ошибка 100...
уже весь алгоритм раз 200 просматривал, чего только не менял - все равно та же ошибка blink.gif


--------------------
Я не люблю, когда мне лезут в душу,
Тем более, когда в нее плюют...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #16


Новичок
*

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

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


с нулевой записью я разобрался... фуф...
но вот 2-е ЕСЛИ ну никак не могу найти... huh.gif
вот что у меня на данный момент:

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.


где-то еще хромает логика...


--------------------
Я не люблю, когда мне лезут в душу,
Тем более, когда в нее плюют...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #17


Новичок
*

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

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


Выручайте, плз!
завтра уже сдавать...
где у меня ошибки (кажется, их несколько)


--------------------
Я не люблю, когда мне лезут в душу,
Тем более, когда в нее плюют...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #18


Гость






Acheter Viagra Femme
 К началу страницы 
+ Ответить 

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

 





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