работа с базой

.pas
Скачиваний:
Добавлен:
01.04.2014
Размер:
19 Кб
Скачать
☆
uses crt;
type     {ЋЇЁб ЁҐ бЇЁбЄ }
	list = ^tSlist;
	TSlist = record
	group, album, song:Pchar;
	year:integer;
	next:list;
	prev:list;
  first:list;
end;

type   {ЋЇЁб ЁҐ бвагЄвгал д ©« }
	TMusicInfo=record
	Group1:PChar[30];
	Year1:integer;
	Album1:PChar[20];
	Song1:PChar[30];
	end;

var    {Ћб®ўлҐ ЇҐаҐ¬ҐлҐ}
SpisNach,
  SpisEnd,Stk,tmpl,fis:List;
	max, min:integer;
	gr1,al1,son1:PChar;
	posy,kzap,ye1,i,Nposition,ost:integer;
	ch,c1:char;
	f:file of TMusicInfo;
	st:TMusicInfo;


procedure AddRecord(var nach,ends:List;grAdd,alAdd,sonAdd:string; yeAdd:integer);
{Їа®жҐ¤га  ¤®Ў ў«ҐЁҐ § ЇЁбЁ}
begin
  if nach=nil then  {Ґб«Ё ў бЇЁбЄҐ Ґв § ЇЁбҐ© }
  begin             {б®§¤ Ґ¬ ЇҐаўго § ЇЁбм}
    Getmem(nach,SizeOf(TSList)); {ўл¤Ґ«ҐЁҐ Ї ¬пвЁ}
    nach^.next:=nil;
    nach^.prev:=nil;
    ends:=nach;
  end
  else {Ґб«Ё Ґбвм § ЇЁбм, ўл¤Ґ«ҐЁҐ Ї ¬пвЁ, ЇҐаҐў®¤ гЄ § вҐ«Ґ©}
  begin
    GetMem(ends^.next,SizeOf(TSlist));
    ends^.next^.prev:=ends;
    ends:=ends^.next;
    ends^.next:=nil;
  end;  {ўҐбҐЁҐ ¤ ле}
 	ends^.next:=nil;
  ends^.group:=grAdd;
	ends^.year:=yeAdd;
	ends^.album:=alAdd;
	ends^.song:=sonAdd;
	kzap:=kzap+1;
end;

procedure Print(spis1:List;print0:integer); {Їа®жҐ¤га  ўлў®¤  ¤ ле}
var sche:integer;
begin
     clrscr;
  sche:=1;
  if spis1=nil then{Ґб«Ё бЇЁб®Є Їгбв®©}
  begin
    writeln('No Records');
    exit;
  end;
  posy:=4;
  while spis1<>nil do {Ґб«Ё бЇЁб®Є Ґ Їгбв®©}
	begin
	if (sche>=min) and (sche<=max) then begin {Ґб«Ё Ї®«®¦ҐЁҐ «Ґ¦Ёв ў ЇаҐ¤Ґ« е ўЁ¤Ё¬®бвЁ}
	if sche=print0 then begin{Ґб«Ё нв® § ЇЁбм   Є®в®а®© бв®Ёв гЄ § вҐ«м}
     textbackground(1);    {¬ҐпҐ¬ жўҐв}
     textcolor(0);
                gotoxy(1,posy); {®ваЁб®ўЄ }
		Write('|| ',spis1^.group);
                gotoxy(17,posy);
                write('|| ', spis1^.album);
                gotoxy(40,posy);
                write('|| ',spis1^.year);
                gotoxy(48,posy);
                write('|| ',spis1^.song);
                gotoxy(78,posy);
                writeln('||');
                posy:=posy+1;
		spis1:=spis1^.next;
		sche:=sche+1;
		end
		else  begin{Ґб«Ё гЄ § вҐ«м Ґ «Ґ¦Ёв   § ЇЁбЁ}
        textbackground(0);
        textcolor(15);
        gotoxy(1,posy);
		Write('|| ',spis1^.group);
                gotoxy(17,posy);
                write('|| ', spis1^.album);
                gotoxy(40,posy);
                write('|| ',spis1^.year);
                gotoxy(48,posy);
                write('|| ',spis1^.song);
                gotoxy(78,posy);
                writeln('||');
                posy:=posy+1;
		spis1:=spis1^.next;
		sche:=sche+1;
		end;
		end
		else begin{Ґб«Ё Ґ ўе®¤Ёв ў §®г ўЁ¤Ё¬®бвЁ}
		spis1:=spis1^.next;
		sche:=sche+1;
		end;
	end;
  end;


procedure search(spis1:List);{Їа®жҐ¤га  Ї®ЁбЄ }
var searching:PChar;
    g1,yea1:integer;
    sor:Char;

begin
     clrscr;
     posy:=4;
     g1:=0;
     if spis1=nil then {Ґб«Ё бЇЁб®Є Їгбв}
     begin
     writeln('No records');
     exit;
     end;  {ўлЎ®а Ї®ЁбЄ }
     writeln('Input whot you wont search');
     writeln('1 - Group');
     writeln('2 - Album');
     writeln('3 - Year');
     writeln('4 - Song');
     sor:=readkey;
     if sor='1' then begin  {Ї® ЈагЇЇҐ}
     Write('Input searching group ');
     readln(searching);
     clrscr;
     gotoxy(1,1);
     writeln('===============================================================================');
     writeln('II    Group     II         Album       II Year II              Song          II');
     writeln('===============================================================================');
     while spis1<>nil do
     begin {Ї®ЁбЄ}
          textbackground(0);
          textcolor(15);
          if spis1^.group = searching then begin {Ґб«Ё Ґбвм § ЇЁбм}
                  textbackground(0);
                  textcolor(15);
                  gotoxy(1,posy);
		              Write('|| ',spis1^.group);
                  gotoxy(17,posy);
                  write('|| ', spis1^.album);
                  gotoxy(40,posy);
                  write('|| ',spis1^.year);
                  gotoxy(48,posy);
                  write('|| ',spis1^.song);
                  gotoxy(78,posy);
                  writeln('||');
                  posy:=posy+1;
     spis1:=spis1^.next;
     g1:=1;
     end
     else spis1:=spis1^.next;
     end;
     if g1=0 then begin
     clrscr;
     writeln('No searching records');
     end;
     readln;
     clrscr;
     end;
     if sor='2' then begin
     Write('Input searching album ');
     readln(searching);
     clrscr;
     g1:=0;
     gotoxy(1,1);
     writeln('===============================================================================');
     writeln('II    Group     II         Album       II Year II              Song          II');
     writeln('===============================================================================');
     while spis1<>nil do
     begin
     if spis1^.album = searching then begin
                  textbackground(0);
                  textcolor(15);
                  gotoxy(1,posy);
		              Write('|| ',spis1^.group);
                  gotoxy(17,posy);
                  write('|| ', spis1^.album);
                  gotoxy(40,posy);
                  write('|| ',spis1^.year);
                  gotoxy(48,posy);
                  write('|| ',spis1^.song);
                  gotoxy(78,posy);
                  writeln('||');
                  posy:=posy+1;
     spis1:=spis1^.next;
     end
     else spis1:=spis1^.next;
     end;
     if g1=0 then begin
     clrscr;
     writeln('No searching records');
     end;
     readln;
     clrscr;
     end;
     if sor='3' then begin
     Write('Input searching year ');
     readln(yea1);
     clrscr;
     g1:=0;
     gotoxy(1,1);
     writeln('===============================================================================');
     writeln('II    Group     II         Album       II Year II              Song          II');
     writeln('===============================================================================');
     while spis1<>nil do
     begin
          textbackground(0);
          textcolor(15);
          if spis1^.year = yea1 then begin
                  textbackground(0);
                  textcolor(15);
                  gotoxy(1,posy);
		              Write('|| ',spis1^.group);
                  gotoxy(17,posy);
                  write('|| ', spis1^.album);
                  gotoxy(40,posy);
                  write('|| ',spis1^.year);
                  gotoxy(48,posy);
                  write('|| ',spis1^.song);
                  gotoxy(78,posy);
                  writeln('||');
                  posy:=posy+1;
     spis1:=spis1^.next;
     g1:=1;
     end
     else spis1:=spis1^.next;
     end;
     if g1=0 then begin
     clrscr;
     writeln('No searching records');
     end;
     readln;
     clrscr;
     end;
     if sor='4' then begin
     Write('Input searching song ');
     readln(searching);
     clrscr;
     g1:=0;
     gotoxy(1,1);
     writeln('===============================================================================');
     writeln('II    Group     II         Album       II Year II              Song          II');
     writeln('===============================================================================');
     while spis1<>nil do
     begin
          textbackground(0);
          textcolor(15);
          if spis1^.song = searching then begin
                  textbackground(0);

                  textcolor(15);
                  gotoxy(1,posy);
		              Write('|| ',spis1^.group);
                  gotoxy(17,posy);
                  write('|| ', spis1^.album);
                  gotoxy(40,posy);
                  write('|| ',spis1^.year);
                  gotoxy(48,posy);
                  write('|| ',spis1^.song);
                  gotoxy(78,posy);
                  writeln('||');
                  posy:=posy+1;

     spis1:=spis1^.next;
     g1:=1;
     end
     else spis1:=spis1^.next;
     end;
     if g1=0 then begin
     clrscr;
     writeln('No searching records');
     end;
     readln;
     clrscr;
     end;



end;

Procedure FreeStek(spis1:List); {®бў®Ў®¦¤ҐЁҐ Ї ¬пвЁ}
var
  tmp:List;
begin
  while spis1<>nil do
  begin
    tmp:=spis1;
    spis1:=spis1^.next;
    FreeMem(tmp,SizeOf(TSlist));
  end;
end;


procedure OpenFile(var nach, ends:list);{®вЄалвЁҐ дЁ©« }
var kol:integer;{Є®«ЁзҐбв® § ЇЁбҐ©}
begin
	kol:=1;
	clrscr;
	assign(f,'c:\mdb\Songs.dat');
	{$I-}
	reset(f);
	{$I+}
	with st do
	repeat
	read(f,st);
  if nach=nil then
  begin

    Getmem(nach,SizeOf(TSList));
    nach^.next:=nil;
    nach^.prev:=nil;
    ends:=nach;
  end
  else
  begin
    GetMem(ends^.next,SizeOf(TSlist));
    ends^.next^.prev:=ends;
    ends:=ends^.next;
    ends^.next:=nil;
  end;
 	ends^.next:=nil;
  ends^.group:=group1;
	ends^.year:=year1;
	ends^.album:=album1;
	ends^.song:=song1;
		kol:=kol+1;
    kzap:=kol;
  	until eof(f);
        close(f);
        kzap:=kzap-1;
        writeln('read ',kzap,' records');
        readln;
end;

procedure SaveRecords(spis1:List);{б®еа ҐЁҐ § ЇЁбҐ©}
var y:integer;
begin

     y:=0;
   assign(f,'c:\mdb\Songs.dat');
  	{$I-}
 	reset(f);
  	{$I+}
  	if ioresult<>0 then rewrite(f); {®вЄалвм ¤«п ЇҐаҐ§ ЇЁбЁ}
  if ost=0 then begin

    with st do repeat
  	group1:=spis1^.group;
    album1:=spis1^.album;
    year1:=spis1^.year;
    song1:=spis1^.song;
    write(f,st);
    spis1:=spis1^.next;
    y:=y+1;
    if y=kzap then break;
    until false;
        close(f);
        clrscr;
        writeln('Record saved');
        readln;
        end;

 if ost>0 then begin
  y:=1;
   with st do repeat
  	group1:=spis1^.group;
    album1:=spis1^.album;
    year1:=spis1^.year;
    song1:=spis1^.song;
    write(f,st);
    spis1:=spis1^.next;
    y:=y+1;
    if y=kzap then break;
    until false;
    seek(f,filesize(f)-ost);
        truncate(f);
        close(f);
        clrscr;
        writeln('Record saved');
        readln;
        end;
ost:=0;


END;

{Їг§ламЄ®ў п б®авЁа®ўЄ }
procedure SortByGroup(nach:list);{б®авЁа®ўЄ  Ї® ЈагЇЇҐ}
var
  tmp,rab:List;
  tmps:PChar;
  tmpi:integer;
begin
  GetMem(tmp,SizeOf(TSlist));
  rab:=nach;
  while rab<>nil do
  begin
    tmp:=rab^.next;
    while tmp<>nil do
    begin
      if tmp^.group<rab^.group then
      begin
        tmps:=tmp^.group;
        tmp^.group:=rab^.group;
        rab^.group:=tmps;
        tmps:=tmp^.album;
        tmp^.album:=rab^.album;
        rab^.album:=tmps;
        tmpi:=tmp^.year;
        tmp^.year:=rab^.year;
        rab^.year:=tmpi;
        tmps:=tmp^.song;
        tmp^.song:=rab^.song;
        rab^.song:=tmps;
      end;
      tmp:=tmp^.next
    end;
    rab:=rab^.next
  end;
end;


procedure SortByAlbum(nach:list);{Ї®  «мЎ®¬г}
var
  tmp,rab:List;
  tmps:PChar;
  tmpi:integer;
begin
  GetMem(tmp,SizeOf(TSlist));
  rab:=nach;
  while rab<>nil do
  begin
    tmp:=rab^.next;
    while tmp<>nil do
    begin
      if tmp^.album<rab^.album then
      begin
        tmps:=tmp^.group;
        tmp^.group:=rab^.group;
        rab^.group:=tmps;
        tmps:=tmp^.album;
        tmp^.album:=rab^.album;
        rab^.album:=tmps;
        tmpi:=tmp^.year;
        tmp^.year:=rab^.year;
        rab^.year:=tmpi;
        tmps:=tmp^.song;
        tmp^.song:=rab^.song;
        rab^.song:=tmps;
      end;
      tmp:=tmp^.next
    end;
    rab:=rab^.next
  end;
end;


procedure SortByYear(nach:list); {Ї® Ј®¤г}
var
  tmp,rab:List;
  tmps:PChar;
  tmpi:integer;
begin
  GetMem(tmp,SizeOf(TSlist));
  rab:=nach;
  while rab<>nil do
  begin
    tmp:=rab^.next;
    while tmp<>nil do
    begin
      if tmp^.year<rab^.year then
      begin
        tmps:=tmp^.group;
        tmp^.group:=rab^.group;
        rab^.group:=tmps;
        tmps:=tmp^.album;
        tmp^.album:=rab^.album;
        rab^.album:=tmps;
        tmpi:=tmp^.year;
        tmp^.year:=rab^.year;
        rab^.year:=tmpi;
        tmps:=tmp^.song;
        tmp^.song:=rab^.song;
        rab^.song:=tmps;
      end;
      tmp:=tmp^.next
    end;
    rab:=rab^.next
  end;
end;


procedure SortBySong(nach:list);{Ї® ЇҐбҐ}
var
  tmp,rab:List;
  tmps:PChar;
  tmpi:integer;
begin
  GetMem(tmp,SizeOf(TSlist));
  rab:=nach;
  while rab<>nil do
  begin
    tmp:=rab^.next;
    while tmp<>nil do
    begin
      if tmp^.song<rab^.song then
      begin
        tmps:=tmp^.group;
        tmp^.group:=rab^.group;
        rab^.group:=tmps;
        tmps:=tmp^.album;
        tmp^.album:=rab^.album;
        rab^.album:=tmps;
        tmpi:=tmp^.year;
        tmp^.year:=rab^.year;
        rab^.year:=tmpi;
        tmps:=tmp^.song;
        tmp^.song:=rab^.song;
        rab^.song:=tmps;
      end;
      tmp:=tmp^.next
    end;
    rab:=rab^.next
  end;
end;


Procedure DelElem(var spis1,spis2:List;tmp:List);{г¤ «ҐЁҐ § ЇЁбЁ}
var
  tmpi:List;
begin
  if (spis1=nil) or (tmp=nil) then
    exit;
  if tmp=spis1 then
  begin
    spis1:=tmp^.next;
    if spis1<>nil then
      spis1^.prev:=nil
    else
      spis2:=nil;
    FreeMem(tmp,SizeOf(TSList));
  end
  else
    if tmp=spis2 then
    begin
      spis2:=spis2^.prev;
      if spis2<>nil then
        spis2^.next:=nil
      else
        spis1:=nil;
      FreeMem(tmp,SizeOf(TSList));
    end
    else
    begin
      tmpi:=spis1;
      while tmpi^.next<>tmp do
        tmpi:=tmpi^.next;
      tmpi^.next:=tmp^.next;
      if tmp^.next<>nil then
        tmp^.next^.prev:=tmpi;
      FreeMem(tmp,sizeof(TSList));

    end;
end;

Procedure Delrecord(var spis1,spis2:List;posi:integer);
var
  int:integer;
  tmp:List;
begin
  if posi<1 then
    exit;
  if spis1=nil then
  begin
    Write('No records');
    exit
  end;
  int:=1;
  tmp:=spis1;
  while (tmp<>nil) and (int<>posi) do
  begin
    tmp:=tmp^.next;
    inc(int)
  end;
  if tmp=nil then
  begin
    Writeln('?<?ї?*?* ? ?R??э?R??ї *Rї??Rї ' ,posi, ' *?? ? ??????.');
    writeln('?????? ????R ' ,int-1, ' ?<?ї?*?R?.');
    exit
  end;
  kzap:=kzap-1;
  DelElem(spis1,spis2,tmp);
  clrscr;
  Writeln('Record deleted');
  ost:=ost+1;
end;

begin
        writeln(memavail);
        readln;
	max:=16;{Ја Ёж  ®ваЁб®ўЄЁ}
	min:=1;
     SpisNach:=nil;
     SpisEnd:=nil;
     clrscr;
     kzap:=0;
     ost:=0;
     Nposition:=1; {Ї®§ЁжЁп Єгаб®а }
     Stk:=nil;
     WRITELN;  {®ваЁб®ўЄ  бв ав }
     WRITELN;
     WRITELN;
     WRITELN;
         WRITELN;
         WRITELN;
         WRITELN;
         WRITELN;
         WRITELN('                 X   X  XX  XX  XXXX  XX XX  X   XXXXX   XXXXX  ');
         WRITELN('                XXX XXX XX  XX XX  XX    XX X    XXXXXX  XX  XX');
         WRITELN('                XX X XX XX  XX XX     XX XXX     XX   XX XX  XX');
         WRITELN('                XX   XX XX  XX  XXX   XX XXXX    XX   XX XXXXXXX  ');
         WRITELN('                XX   XX XXX XX    XXX XX XX XX   XX   XX XX   XX');
         WRITELN('                XX   XX XXXXXX X  XXX XX XX XX   XXXXXX  XX   XX ');
         WRITELN('                XX   XX XXXXX   XXX   XX XX XX   XXXXX   XXXXXX  ');
         READKEY;
         clrscr;
while c1<>#27 do begin {а Ў®в  ¬Ґо}

	{Ќ з «® Їа®ўҐаЄЁ}

			if (nposition>max-1) and (max<kzap) then begin
				min:=min+1;
				max:=max+1;
			end;


			if (nposition<min+1) and (min>1) then begin
				min:=min-1;
				max:=max-1;
			end;

	{Љ®Ґж Їа®ўҐаЄЁ}
   {®ваЁб®ўЄ  Ј« ў®Ј® ¬Ґо}
                    textbackground(0);
                        textcolor(15);
                        gotoxy(1,1);
                	writeln('===============================================================================');
			writeln('II    Group     II         Album       II Year II              Song          II');
                        writeln('===============================================================================');
                        gotoxy(1,20);
                        writeLN('===============================================================================');
                        WRITELN('F - SEARCH      D - DELETE RECORD      P - Add Record     O - Oen file');
                        WRITELN('G - Sort by grop; A - Sort by album; Y - Sort by year; S - Sort by song T - Save');
  c1:=readkey;
  {®вЄалвЁҐ д ©« }
  IF c1=#111 THEN BEGIN FreeStek(SpisNach); OPENFILE(SpisNach,SpisEnd);print(spisnach,nposition);  END;
  {Ї®ЁбЄ}
  IF c1=#102 THEN BEGIN SEARCH(spisnach); Print(Spisnach, Nposition);  END;
  {б®авЁа®ўЄ  Ї® ЈагЇЇҐ}
  IF c1=#103 THEN BEGIN SORTBYGROUP(SpisNach); print(SpisNach,Nposition); END;
  {Ї®  «мЎ®¬г}
  if c1=#97 then BEGIN SORTBYALBUM(SpisNach); print(SpisNach,Nposition);  END;
  {Ї® Ј®¤г}
  if c1=#121 then BEGIN SORTBYYEAR(SpisNach); print(SpisNach,Nposition);  END;
  {Ї® ЇҐбҐ}
  IF c1=#115 THEN BEGIN SORTBYSONG(SpisNach); print(SpisNach,Nposition);  END;
  {б®еа ҐЁҐ § ЇЁбҐ©}
  IF c1=#116 THEN BEGIN SaveRecords(spisnach);print(spisnach,nposition);  END;
  IF c1=#100 THEN BEGIN                         {ўл§®ў Їа®жҐ¤гал г¤ «ҐЁп § ЇЁбЁ}
  if Nposition>kzap then kzap:=kzap-1;
     DelRecord(SpisNach,SpisEnd,Nposition);
     if Nposition>kzap then Nposition:=Nposition-1;
     print(spisnach,nposition); GOTO PPP; END;
  IF c1=#112 THEN BEGIN
  repeat                                                   {ўл§®ў Їа®жҐ¤гал ¤®Ў ў«ҐЁп § ЇЁбЁ}
        clrscr;
		writeln('The menu of addition of record');
		write('Enter the group name: ');
 		readln(gr1);
		write('Enter the album name: ');
		readln(al1);
		write('Enter year of release of an album: ');
		readln(ye1);
                write('Enter a song: ');
		readln(son1);
    AddRecord(SpisNach,SpisEnd,gr1,al1,son1,ye1);
		write('For an exit press "1"');
                c1:=readkey;
	until c1='1';
	clrscr;
	print(SpisNach,Nposition);
	END;
	if c1=#0 then begin                    { ўЁЈ жЁп Ї® ¬Ґо}
          c1:=readkey;
  if c1=#72 then begin
          if Nposition>1 then begin
          Nposition:=Nposition-1;
          if Nposition<kzap then begin
          textbackground(0);
          textcolor(15);
          print(SpisNach,Nposition);
          end;
          end;
          end;
  if c1=#80 then begin
          if Nposition<Kzap then begin
          Nposition:=Nposition+1;
          print(SpisNach,Nposition);
          end;
          end;
          end;
          end;
          clrscr;
          FreeStek(spisnach);  {®бў®Ў®¦¤ҐЁҐ Ї ¬пвЁ}
          gotoxy(74, 20);
          write('ver 2.0');
          writeln(memavail);

          readkey;
end.
Соседние файлы в предмете Основы алгоритмизации и программирования
#
01.04.201445 Кб13ПОИТ Контрольная работа по основам алгоритмизации.№2-10.docx
#
01.04.2014109 Кб29ПОИТ Лабораторная работа по основам алгоритмизации.№1-21.docx
#
01.04.2014130 Кб28ПОИТ Лабораторная работа по основам алгоритмизации.№2-21.docx
#
01.04.201468 Кб9ПОИТ ОАИП часть1 КР2 Вариант № 6.doc
#
01.04.201486 Кб10Программирование, Контрольная 17 вариант.doc
#
01.04.201419 Кб3работа с базой.pas
#
01.04.201456 Кб16Часть 1. Вариант 12.doc
#
01.04.201453 Кб17Часть 1. Вариант 19.doc