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

Оглавление Постановка задачи 2 Описание процедур 3 Машинное тестирование 6 Список литературы 9 Приложение А. Текст программы. 10 Главная (вызывающая программа) 10 Модуль xchar 10 Модуль unit 1 16 Содержание

hours,strdig); repeatsetcolor(txt,back);gotoxy(x+28,y+4); write('Hours');inputstr(x+36,y+4,15,0,strdig,digits,3);val(strdig,p[index].hours,code); until (code=0); str(p[index].students,strdig); repeatsetcolor(txt,back);gotoxy(x+2,y+6); write('Students');inputstr(x+16,y+6,15,0,strdig,digits,3);val(strdig,p[index].students,code);until (code=0); strtmp:=''; str(p[index].date:2,strdig);strtmp:=strtmp+strdig+'\'; str(p[index].month:2,strdig);strtmp:=strtmp+strdig+'\'; str(p[index].year:2,strdig);strtmp:=strtmp+strdig; repeatsetcolor(txt,back);gotoxy(x+2,y+8); write('Date\Month\Year');inputstr(x+25,y+8,15,0,strtmp,digdot,14); until (validdate(strtmp,p[index].date,p[index].month,p[index].year)); setcolor(txt,back);gotoxy(x+2,y+10); write('Press E (for Exam) or Z (for Zachet');repeat cc:=readkey; until (upcase(cc)='E')or(upcase(cc)='Z'); if upcase(cc)='E' then p[index].exam:=true else p[index].exam:=false;end;procedure addrec(var a:recarray;var k:integer;var alloc_size:longint);beginif (k>maxsize) then begin status(12,0,'Memory allocation failed'); exit;end;editrec(editx,edity,14,9,true,a,k,k);inc(k);end;procedure delrec(var a:recarray;index:integer;var k :integer);var i:integer;beginif (k<=0) then exit;if (index<k-1) thenfor i:=index+1 to k-1 do a[i-1]:=a[i];dec(k);end;function newfile(fname:string;var size:integer):boolean;var f:file;begin{$I-}assign(f,fname); rewrite(f); close(f); {$I+}newfile:= (IOresult=0); size:=0;end;function loadfile(fname:string;var a:recarray;var k:integer):boolean;var f:file;begin{$I-}assign(f,fname);reset(f,recsize); {$I+}if (IOresult<>0) then begin loadfile:=false;exit; end;k := filesize(f); if (k>maxsize) then begin status(12,0,'Memory allocation failed'); loadfile:=false;exit; end;{$I-}blockread(f,a,k); close(f);{$I+}loadfile:=(IOresult=0);end;function savefile (fname:string;var a:recarray;k:integer):boolean;var f:file;begin{Si-}assign(f,fname);rewrite(f,recsize); blockwrite(f,a,k);close(f);{$I+} savefile:=(IOresult=0);end;procedure inputstr(x,y,txt,back:integer;var str,allow:string;maxsize:integer);var i,j,k:integer; c,c1:char;beginsetcolor(txt,back); c:=#0;if (str[0]=#0) then k:=0 else k:= length(str);while (c<>ENTER) do begingotoxy(x,y);for i:=0 to maxsize-2 do write(' ');gotoxy(x,y);write(str);c:= readkey; if (c =#0) then c1:= readkey;if (pos(c,allow)<>0) thenif (k<maxsize-1)then beginstr:=str+c;inc(k);end;if (c=BACKSPACE) thenif (k>0)then begindec(str[0]);dec(k);end;end;end;{{{{{{{{{{{{{}function validdate(str:string;var date,month,year:word):boolean;var i:integer;begin if length(str)<8 then begin validdate:=false;exit; end; for i:=1 to length(str) do if(str[i]=' ')or(str[i]=#0) then str[i]:='0'; date:= (ord(str[1])-ord('0'))*10+ord(str[2])-ord('0'); month:=(ord(str[4])-ord('0'))*10+ord(str[5])-ord('0'); year:= (ord(str[7])-ord('0'))*10+ord(str[8])-ord('0'); validdate:=(date>0)and(date<32)and(month>0)and(month<13)and(year>0);end;{{{{{{{{{{{}procedure infoline(var p:recarray; size,date,month,year:integer);var exm,zach,y,i,j,k,s:integer;type sets=array[1..50] of integer; strings=array[1..50] of string[12];var groups:sets; prepods,subj:strings; sum,topprep,topexams,ngroups,nprepods,nsubj:integer;function inintset(a:integer;b:sets;size:integer):boolean;var i:integer;beginif size<1 then begin inintset:=false;exit;end;for i:=0 to size-1 do if b[i]=a then begin inintset:=true;exit;end;inintset:=false;end;function instrset(a:string;b:strings;size:integer):boolean;var i:integer;beginif size<1 then begin instrset:=false;exit;end;for i:=0 to size-1 do if b[i]=a then begin instrset:=true;exit;end;instrset:=false;end;begin setcolor(14,0); y:=menuy+menuysize+1; for i:=y to statusy-1 do begin gotoxy(2,i); for j:=2 to 78 do write(' '); end; if (size<1) then exit; ngroups:=0; nprepods:=0;nsubj:=0; for i:=0 to size-1 do begin if (not inintset(p[i].group,groups,ngroups) )then begin inc(ngroups);groups[ngroups]:=p[i].group; end; if (not instrset(p[i].prepod,prepods,nprepods)) then begin inc(nprepods);prepods[nprepods]:=p[i].prepod; end; if (not instrset(p[i].discipline,subj,nsubj)) then begin inc(nsubj);subj[nsubj]:=p[i].discipline; end; end; exm:=0; zach:=0; gotoxy(2,y);write('Grp\exam\zach-'); for i:=1 to ngroups do begin write(groups[i],'\'); for j:=0 to size-1 do if p[j].group=groups[i] then if p[j].exam then inc(exm) else inc(zach); write(exm,'\',zach,' '); end; topprep:=1; topexams:=0; for i:=1 to nprepods do begin sum:=0; for j:=1 to size-1 do if (p[j].prepod=prepods[i])and(p[j].exam) then sum:=sum+p[j].students; if sum>topexams then begin topexams:=sum;topprep:=i;end; end; gotoxy(2,y+1); write('Prepod ',prepods[topprep],' max exams-',topexams); gotoxy(2,y+2); write('List of subj (zachets)-'); for i:=1 to nsubj do for j:=0 to size-1 do if (p[j].discipline=subj[i])and(not p[j].exam) then begin write(subj[i],' ');break; end; gotoxy(2,y+3); write('List of group(exams)in curr date-'); for i:=1 to ngroups do for j:=0 to size-1 do if (p[j].group=groups[i])and(p[i].exam)and(p[i].date=date)and (p[i].month=month)and(p[i].year=year) then begin write(groups[i],' ');break; end; exm:=0; zach:=0; gotoxy(2,y+4); write('Total students on exams\zach-');for i:=0 to size do if p[i].exam then exm:=exm+p[i].students else zach:=zach+p[i].students; write(exm,'\',zach);end;procedure zastavka;var i,x,y:integer;begin randomize; for i:=1 to 2000 do begin x:=1+random(80); y:=1+random(24); gotoxy(x,y);setcolor(1+random(15),1+random(15)); write(chr(1+random(31))); end;setcolor(1,14);window(3,1,76,21,'');writestring(8,2 ,'Students');writestring(4,13,'term work');repeat until keypressed;while keypressed do i:=ord(readkey);setcolor(15,0);end;{----------------}procedure setcolor(c,b:integer);begin textcolor(c mod 256); textbackground(b mod 256);end;procedure clearline(i:integer);begin gotoxy(1,i); for i:=1 to 80 do write(' ');end;procedure window(x1,y1,x2,y2:integer; header:string);var i:integer;begin for i:=x1 to x2 do begin gotoxy(i,y1);write('Д'); gotoxy(i,y2);write('Д'); end; for i:=y1 to y2 do begin gotoxy(x1,i);write('і'); gotoxy(x2,i);write('і'); end; gotoxy(x2,y1);write('ї'); gotoxy(x1,y2);write('А'); gotoxy(x2,y2);write('Щ'); gotoxy(x1,y1);write('Ъ'); gotoxy((x2+x1-length(header))div 2,y1); write(header);end;procedure floodwindow(color,back,x1,y1,x2,y2:integer; header:string);var i,j:integer;begin setcolor(color,black); for i:=y1 to y2 do begin gotoxy(x1,i); for j:=x1 to x2 do write(' '); end; window(x1,y1,x2,y2,header);end;{----------------}beginend.