Разработка информационно-поисковой системы

 

 

 

 

 

Снимок экрана

 

 

Процедура create

Данная процедура служит для создания базы данных в типизированном файле и дополнения файла новыми записями.

 

Используемые переменные

Имя	Смысл	Назначение	Ограничения
ans	перебор базы	промежуточная	целый
i	счетчик	промежуточная	целый
n	последовательное  значение	промежуточная	целый

 

 

 

 

Текст программы

procedure create;

var ans,j,n:byte; i:integer;

begin

clrscr;

textcolor(white);

write('0 - to create baza, 1 - to continue baza ');

readln(n);writeln;

case n of

0:begin rewrite(f);i:=0; end;

1:begin reset(f);seek(f,filesize(f));i:=filepos(f)

end

end;

 

repeat

      clrscr;

      i:=i+1;textcolor(green);

      writeln('Input record number ',i);

      with z do begin

           index:=i;

 

 

           textcolor(red);

           write('Vvedite nazvanie filma ');

           textcolor(yellow);

           readln(name);writeln;

 

           textcolor(red);

           write('Vvedite familiu rezhissera ');

           textcolor(yellow);

           readln(rezh);writeln;

 

           textcolor(red);

           write('Vvedite familiu glavnogo aktera ');

           textcolor(yellow);

           readln(akt);writeln;

 

           textcolor(red);

           write('Vvedite stranu, vypustivshuyu film ');

           textcolor(yellow );

           readln(strana);

           writeln;

 

           textcolor(red);

           write('Vvedite god vypuska filma ');

           textcolor(yellow);

           readln(god);

           writeln;

 

           textcolor(red);

           write('Vvedite dlitelnost filma ');

           textcolor(yellow);

           readln(dlit);

           writeln;

 

           textcolor(red);

           write('Vyberite - vydan li flim seichas  ');

           textcolor(yellow);

           writeln('1 - Da, 2 - Net');

           readln(n);

           if n=1 then kod:=true else kod:=false;

           writeln;

 

           textcolor(red);

           write('Vvedite datu vydachi filma ');

           textcolor(yellow);

           readln(datavyd);

           writeln;

 

           textcolor(red);

           write('Vvedite srok, na kotory vydan film ');

           textcolor(yellow);

           readln(srok);

           writeln;

 

           textcolor(red);

           write('Vvedite stoimost prokata v sutki ');

           textcolor(yellow);

           readln(prokat);

           writeln;

 

           textcolor(lightred);

           writeln('Dobavleno!')

           end;

 

       write(f,z);writeln;

       textcolor(white);

       write('0 - exit, 1 - continue ');

       readln(ans);writeln;

       until ans=0;

       clrscr;

       close(f);

       end;

 

Блок схему см. в Приложении (Рис.4)

 

Снимок экрана

 

 

 

 

 

 

 

Процедура display

Эта процедура выводит базу данных на экран.

 

Текст программы

 

procedure display;

const s:array[1..10] of string=

      ('N','Nazv','Director','Actor','Strana','God','Kod','Vydan','Srok','$');

var i:integer;ans:byte;

begin

     repeat

     clrscr; textcolor(green);

     gotoxy(1,1); write(s[1]);

     gotoxy(3,1);write(s[2]);

     gotoxy(15,1);write(s[3]);

     gotoxy(25,1);write(s[4]);

     gotoxy(35,1);write(s[5]);

     gotoxy(43,1);write(s[6]);

     gotoxy(48,1);write(s[7]);

     gotoxy(54,1);write(s[8]);

     gotoxy(63,1);write(s[9]);

     gotoxy(70,1);write(s[10]);

 

     i:=2;

     reset(f);textcolor(yellow);

     while not eof(f) do

           begin read(f,z); i:=i+1;

           with z do begin

           gotoxy(1,i);write(index);

           gotoxy(3,i);write(name);

           gotoxy(15,i);write(rezh);

           gotoxy(25,i);write(akt);

           gotoxy(35,i);write(strana);

           gotoxy(43,i);write(god);

           gotoxy(48,i);write(kod);

           gotoxy(54,i);write(datavyd);

           gotoxy(63,i);write(srok);

           gotoxy(68,i);write(prokat:0:2);

           end;

     end;

     gotoxy(10,20);textcolor(white);

     write('0 - exit ');

     read(ans);clrscr;

     until ans=0; close(f);end;

 

 

 

Блок схему см. в Приложении (Рис.5)

 

 

 

 

Снимок экрана

 

 

 

 

Процедура filmb

Данная процедура уже занимается обработкой файла базы данных. В результате её работы программа выводит на экран список фильмов, начинающихся на заданную пользователем букву.

 

Используемые переменные

Имя	Смысл	Назначение	Ограничение
ans	перебор базы	промежуточная	целый
buk	Ввод буквы	промежуточная	символьный
s	флажок	счетчик	целый

 

Текст программы

procedure filmb;

var  ans,s:byte;buk:char;

begin

    clrscr;

     textcolor(yellow);

     write('Vvedite bukvu ');

     textcolor(green);

     readln(buk);

     writeln;

     s:=0;

     writeln('Spisok filmov na etu bukvu:');

     textcolor(yellow);

     repeat

     reset(f);

 

     while not eof(f) do begin

     read(f,z);

 

     if ((copy(z.name,1,1)=buk) or (copy(z.name,1,1)=upcase(buk))) then

     begin

     writeln(z.name);

     s:=s+1;

     end;

     end;

     if s=0 then writeln('Filmov na etu bukvu net!');

     writeln;

     textcolor(white);

     write('0 - exit ');

     readln(ans)

     until ans=0;

     close(f);

     clrscr;

     end;

 

Блок схему см. в Приложении (Рис.6)

 

 

Снимок экрана

 

 

Процедура godvyp

Эта процедура ищет фильмы, выпущенные в заданном году, определяет их наличие и сортирует по названию. 
 
Используемые переменные

имя	смысл	назначение	ограничения
ans	перебор базы	промежуточная	целый
i	счетчик	промежуточная	целый
s	флажок	промежуточная	целый
vyp	год выпуска  фильма	промежуточная	целый

 

Текст программы

procedure godvyp;

var ans,s,i,j:byte;vyp:integer;c:string;a:array[1..30]of string;

begin

clrscr;

textcolor(green);

writeln('Vvedite god vypuska filmov');

readln(vyp);

textcolor(yellow);

writeln('V etom godu vypusheny filmy:');

s:=0;

repeat

reset(f);

while not eof(f) do begin

read(f,z);

if z.god=vyp then begin

s:=s+1;

a[s]:=z.name; end;

end;

close(f);

for i:=1 to s-1 do

    for j:=1 to s-i do

    if a[j]>a[j+1] then begin

    c:=a[j];a[j]:=a[j+1];a[j+1]:=c;

    end;

writeln;

for i:=1 to s do

writeln(a[i]);

if s=0 then writeln('V etot god net filmov!');

textcolor(yellow);

writeln('0 - exit ');

readln(ans);

until ans=0;

clrscr;

end;

 

 

Блок схему см. в Приложении (Рис.7)

 

Снимок экрана

 
 
Процедура actor

Процедура находит, когда выданы фильмы с участием заданного пользователем актёра.

 

Используемые переменные.

имя	смысл	назначение	ограничения
ans	перебор базы	промежуточная	целый
s	флажок	промежуточная	целый
fam	выбор фамилии  актера	промежуточная	символьный

 

 

Текст программы

procedure actor;

var ans,s:byte;fam:string[10];

begin

clrscr;

textcolor(yellow);

writeln('Vvedite familiu actera');

readln(fam);

textcolor(yellow);

 

s:=0;

repeat

reset(f);

while not eof(f) do begin

read(f,z);

with z do

if z.akt=fam then begin

s:=s+1;

with z do

if kod then

writeln('Film "',name,'" vydan ',datavyd)

else writeln('Film ',name,' na danniy moment ne vydan');

end;

end;

close(f);

 

if s=0 then writeln('Filmov s etim akterom net!');

writeln('0 - exit');

readln(ans);

until ans=0;

clrscr;

end;

Блок схему см. в Приложении (Рис.8)

 

 

Снимок экрана

 

Процедура nazv

Данная процедура считает стоимость проката на заданный срок.

Используемые переменные.

имя	смысл	назначение	ограничения
ans	перебор базы	промежуточный	целый
s	флажок	промежуточный	целый
nazv	ввод названия фильма	промежуточный	символьный
stoim	вывод стоимости	промежуточный	целый

 

Текст программы

procedure nazv;

var ans,s:byte;nazv:string;stoim:real;

begin

clrscr;

textcolor(lightgreen);

writeln('Vvedite nazvanie filma');

readln(nazv);

s:=0;

 

textcolor(yellow);

writeln('Stoimost prokata na zadanny srok:');

textcolor(white);

repeat

reset(f);

 

while not eof(f) do begin

read(f,z);

 

if z.name=nazv then begin

s:=s+1;

with z do

Stoim:=prokat*srok;

writeln(Stoim:0:2,' $ ');

end;

end;

close(f);

writeln;

textcolor(lightred);

writeln('0 - exit ');

readln(ans);

until ans=0;

clrscr;

end;

 

Блок схему см. в Приложении (Рис.9)

 

Снимок экрана

 

 

 

 

 

 

 

 

 

 

 

 

 

Исходный код

program kursovik;

  uses crt;

  const punkt:array[1..7]of string=

        ('1 - sozdanie i dopolnenie',

        '2 - vyvod na ekran',

        '3 - film nachinaetsa s bukvy',

        '4 - filmy v etom godu',

        '5 - filmy s uchastiem aktera',

        '6 - stoimost prokata na srok',

        '7 - exit');

 

type zap=record name:string[20];

                rezh,akt,strana:string[18];

                kod:boolean;

                datavyd:string[8];

                index,god,dlit,srok:integer;

                prokat:real;

                end;

var f:file of zap; z:zap; i:integer;

 

procedure frame(xs,ys,w,h:byte);

var x,y,xf,yf:byte;

begin

textcolor(3);

xf:=xs+w-1; yf:=ys+h-1;

gotoxy(xs,ys);

write(chr(201));

x:=xs+1; y:=ys;

 

repeat

        gotoxy(x,y);

        write(chr(205));

        inc(x);

until x=xf+1;

 

gotoxy(x,y);

write(chr(187));

inc(y);

 

repeat

        gotoxy(x,y);

        write(chr(186));

        inc(y);

until y=yf;

 

gotoxy(x,y);

write(chr(188));

dec(x);

 

repeat

        gotoxy(x,y);

        write(chr(205));

        dec(x);

until x=xs;

 

gotoxy(x,y);

write(chr(200));

dec(y);

 

repeat

        gotoxy(x,y);

        write(chr(186));

        dec(y);

until y=ys;

textcolor(7);

end;

 

 

procedure zastavka;

begin clrscr;

frame (24,7,33,13);

gotoxy(33,11);

textcolor(14);

write('Kursovay rabota');

gotoxy(31,13);textcolor(5);write(' FTKiT  214 gryppa');

gotoxy(30,16);textcolor(12);write('   Muravieva Alina');

gotoxy(41,18);

readkey;

end;

 

procedure menu(var p:integer);

var i:integer; key:char;

begin clrscr;

frame(20,4,45,19);

     textcolor(8);

     gotoxy(30,7); write('Videoprokat');

     textcolor(13);

     for i:=1 to 7 do

         begin gotoxy(30,10+i); write(punkt[i]); end;

    p:=1;

repeat

      textbackground(15);

      gotoxy(30,10+p);

      write(punkt[p]);

      repeat until keypressed;

      key:=readkey;

      if key=#0 then key:=readkey;

      textbackground(0);

      gotoxy(30,10+p);

      write(punkt[p]);

 

      case key of

      #72: p:=p-1;

      #80: p:=p+1;

      end;

 

      if p>7 then p:=1 else

      if p<1 then p:=7;

  until key=#13;

  clrscr;

end;

 

 

procedure create;

 

var ans,j,n:byte; i:integer;

begin

clrscr;

textcolor(white);

write('0 - to create baza, 1 - to continue baza ');

readln(n);writeln;

case n of

0:begin rewrite(f);i:=0; end;

1:begin reset(f);seek(f,filesize(f));i:=filepos(f)

end;

end;

 

repeat

      clrscr;

      i:=i+1;textcolor(green);

      writeln('Input record number ',i);

      with z do begin

           index:=i;

 

           textcolor(green);

           write('Vvedite nazvanie filma ');

           textcolor(yellow);

           readln(name);writeln;

 

           textcolor(green);

           write('Vvedite familiu rezhissera ');

           textcolor(yellow);

           readln(rezh);writeln;

 

           textcolor(green);

           write('Vvedite familiu glavnogo aktera ');

           textcolor(yellow);

           readln(akt);writeln;

 

           textcolor(green);

           write('Vvedite stranu, vypustivshuyu film ');

           textcolor(yellow);

           readln(strana);

           writeln;

 

           textcolor(green);

           write('Vvedite god vypuska filma ');

           textcolor(yellow);

           readln(god);

           writeln;

 

           textcolor(green);

           write('Vvedite dlitelnost filma ');

           textcolor(yellow);

           readln(dlit);

           writeln;

 

           textcolor(green);

           write('Vyberite - vydan li flim seichas  ');

           textcolor(yellow);

          writeln('1 - Da, 2 - Net');

           readln(n);

           if n=1 then kod:=true else kod:=false;

           writeln;

 

           textcolor(green);

           write('Vvedite datu vydachi filma ');