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

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

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

> Файлы, помогите исправить программу,пожалуйста
Ellsa
сообщение 9.01.2007 17:31
Сообщение #1


lehf
**

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

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


Мое задание:
Сведения о магазинах города,которые состоят из названия,района,адреса,часов работы.Вывести сведения о книжных магазинах данного района,работающих после 18 часов,и число таких магазинов.


Прога идет,но не считает.В чем может быть ошибка,не подскажете? unsure.gif

program z522;

type sved=record
nazv,rayon,adr:string;
chas:integer;
end;
fsved=file of sved;
var kol:integer;
i:byte;
f:fsved;
numb:integer;
sv:sved;s:char;
name:string;
begin
repeat write('imya fajla: ');readln(name);
if name='' then halt;assign(f,name);s:='Y';
{$I-}reset(f);{$I+} if IOResult<>0 then
begin write('otkrit new fajl ', name, '?(Y/N)');
readln(s); if upcase(s)='Y' then
begin {$I-}rewrite(f);{$I+} if IOResult<>0 then
begin writeln('disk nedostypen');name:= '' end; end
else name:='';
end until name<>'';
numb:=0;
if upcase(s)='Y' then
begin seek(f,filesize(f));numb:=filesize(f) end;
writeln('vsego zapisej',numb, 'vvadite ocherednyjy zapis:');numb:=numb+1;


with sv do repeat
writeln('nazv');
readln(nazv);
writeln('rayon');readln(rayon);
writeln('adr');readln(adr);
writeln('chas');readln(chas);
write(f,sv);
write('vvod sled zapisi&(Y/N)');
readln(s) until upcase(s)<>'Y';

begin
while not eof(f) do begin
kol:=0;
read(f,sv);
for i:=1 to numb do
with sv do
if (nazv='kniznij') and (rayon='himki') and (chas>18) then
begin kol:=kol+1;
writeln ('knizhnie magazini v dannom rayone,rabotajuwie posle 18');
writeln ('rayon');writeln(rayon);
writeln ('chasi');writeln(chas);
writeln('adres');writeln(adr);

end;end;
if kol=0 then writeln('dannix net');
close (f);
end;
writeln(kol);

end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
Ellsa
сообщение 9.01.2007 20:26
Сообщение #2


lehf
**

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

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


на подобии программы Klem4 (спасибо большое!)
сделала такую,но она опять не работает....помогите,пожалуйста....

program z522;

type sved=record
nazv,rayon,adr:string;
chas:integer;
end;
fsved=file of sved;
var kol:integer;
i:byte;
f:fsved;
numb:integer;
sv:sved;s:char;
name:string;
begin
repeat write('imya fajla: ');readln(name);
if name='' then halt;assign(f,name);
{$I-}reset(f);{$I+} if IOResult<>0 then
begin write('otkrit new fajl ', name, '?(Y/N)');
readln(s); if upcase(s)='Y' then
begin {$I-}rewrite(f);{$I+} if IOResult<>0 then
begin writeln('disk nedostypen');name:= '';end ; end
else name:='';end;

until name<>'';
repeat
write('New record?<Y/N>');
readln(s);

if upcase(s)='Y' then begin numb:=0;
begin seek(f,filesize(f));numb:=filesize(f) end;
writeln('vsego zapisej',numb, 'vvadite ocherednyjy zapis:');numb:=numb+1;


with sv do begin
writeln('nazv');
readln(nazv);
writeln('rayon');readln(rayon);
writeln('adr');readln(adr);
writeln('chas');readln(chas);
write(f,sv); end;
end until upcase(s)<>'Y';

begin kol:=0;
while not (eof(f)) do begin

read(f,sv);

if (sv.nazv='kniznij') and (sv.rayon='himki') and (sv.chas>18) then
begin
writeln ('knizhnie magazini v dannom rayone,rabotajuwie posle 18');
writeln(sv.rayon);
writeln(sv.chas);
writeln(sv.adr);inc(kol);

end;end;
if kol=0 then writeln('dannix net') else
writeln(kol); end;
close(f);
end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
kramolnic
сообщение 10.01.2007 1:48
Сообщение #3


Новичок
*

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

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


Цитата(Ellsa @ 9.01.2007 20:26) *

на подобии программы Klem4 (спасибо большое!)
сделала такую,но она опять не работает....помогите,пожалуйста....

Вот текст программы.. прошу прощения, что весь код.. так проще...

program z522;

type sved=record
nazv,rayon,adr:string;
chas:integer;
end;
fsved=file of sved;
var kol:integer;
i:byte;
f:fsved;
numb:integer;
sv:sved;s:char;
name:string;
begin
repeat write('imya fajla: ');readln(name);
if name='' then halt;assign(f,name);
{$I-}reset(f);{$I+} if IOResult<>0 then
begin write('otkrit new fajl ', name, '?(Y/N)');
readln(s); if upcase(s)='Y' then
begin {$I-}rewrite(f);{$I+} if IOResult<>0 then
begin writeln('disk nedostypen');name:= '';end; end
else name:='';end;

until name<>'';
repeat
write('New record?<Y/N>');
readln(s);

if upcase(s)='Y' then begin numb:=0;
begin seek(f,filesize(f));numb:=filesize(f) end;
writeln('vsego zapisej',numb, 'vvadite ocherednyjy zapis:');numb:=numb+1;


with sv do begin
writeln('nazv');
readln(nazv);
writeln('rayon');readln(rayon);
writeln('adr');readln(adr);
writeln('chas');readln(chas);
write(f,sv); end;
end until upcase(s)<>'Y';

begin kol:=0;

Seek(f, 0);
while not (eof(f)) do begin

read(f,sv);

if (sv.nazv='kniznij') and (sv.rayon='himki') and (sv.chas>18) then
begin
writeln ('knizhnie magazini v dannom rayone,rabotajuwie posle 18');
writeln(sv.rayon);
writeln(sv.chas);
writeln(sv.adr);inc(kol);

end;end;
if kol=0 then writeln('dannix net') else
writeln(kol); end;
close(f);
readln;
end.

надо было перед подсчетом количества сначала сделать Seek(f, 0), т.е. перевести указатель на начало файла.. а то после добавления указатель смещается к концу.. у меня заработало...

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

Сообщений в этой теме


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

 



- Текстовая версия 20.07.2025 3:09
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"