Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Файлы

Автор: Ellsa 9.01.2007 21:31

Мое задание:
Сведения о магазинах города,которые состоят из названия,района,адреса,часов работы.Вывести сведения о книжных магазинах данного района,работающих после 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.

Автор: klem4 9.01.2007 22:51

Вроде этого ?

uses crt;

type

  TShop = record
    name, location, area: String;
    hour: Byte;
  end;

  TDataFile = file of TShop;


var
  T: TShop;
  F: TDataFile;
  count: Integer;
  choice: char;

begin
  clrscr;

  assign(f, 'shops.db');

  {$I-} reset(f); {$I+}

  if IOResult <> 0 then begin

    write('New file ? <Y/N>');
    readln(choice);


    if choice in ['y', 'Y'] then begin

      rewrite(f);

      repeat
        write('New record ? <Y/N>'); readln(choice);
        if choice in ['Y', 'y'] then begin
          write('Name = '); readln(T.Name);
          write('Location = '); readln(T.Location);
          write('Area = '); readln(T.Area);
          write('Hour = '); readln(T.Hour);
          write(f, T);
        end;
      until choice in ['N', 'n'];
    end;

  end else begin

    count := 0;

    while not(eof(f)) do begin

      read(f, T);

      if T.hour > 18 then begin
        writeln(T.Name); inc(count);
      end;

    end;

    writeln('Count = ', count);
  end;

  close(f);
  readln;
end.



зы проверку на район только добавить надо

Автор: Ellsa 10.01.2007 0: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;
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.

Автор: kramolnic 10.01.2007 5:48

Цитата(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), т.е. перевести указатель на начало файла.. а то после добавления указатель смещается к концу.. у меня заработало...

Автор: Ellsa 10.01.2007 6:03

kramolnic

Спасибо тебе большое!!!! rolleyes.gif give_rose.gif
Очень выручил,я сама никак не могла додуматься.... blush.gif

спасибо!
Но только один вопрос....зачем в самом конце
readln?
Меня всегда интересовал этот вопрос. smile.gif

Автор: Bokul 10.01.2007 6:07

Чтобы ты успела прочитать то, что написала программа. А вообще самый лучший метод обучения - это метод проб и ошибок, экспериментируй! yes2.gif

Автор: Ellsa 10.01.2007 6:09

так я же эксперементирую... blush.gif
плохо может...но я же пытаюсь... unsure.gif

Автор: Lapp 10.01.2007 9:22

Цитата(Ellsa @ 10.01.2007 3:09) *

так я же эксперементирую... blush.gif
плохо может...но я же пытаюсь... unsure.gif

Bokul имел в виду, что если у тебя возник такой вопрос, то самое простое - это попробовать убрать непонятный оператор, и посмотреть, что будет без него. Это и есть типа "экспериментальный подход" smile.gif.
(совет: прогнав программу без ReadLn, нажми Alt-F5)