Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
16
Добавлен:
02.05.2014
Размер:
16.68 Кб
Скачать
program TP;
uses dos,crt,strings;

label writing,pov1,pov2,pov3,op1,op2,op3,fin,sort;
var
namef1,namef2,namef3:string;
namef11,namef12,namef13:text;
erroropen:boolean;
chk,nnnumb,maxlen4,m,m1,m2,j,j1,j3,j5,j4,sizef1,sizef2,sch:integer;
n:array[1..500] of string;
h:array[1..10000] of string;

function getnum(str:string):integer;
label 1;
var
i,number:integer;
numb:string;
begin
number:=0;
numb:='';
for i:=1 to 100 do begin
if str[i]=':' then goto 1;
numb:=numb+str[i];
end;
1:
val(numb,number,i);
if i=0 then getnum:=number else getnum:=0;
end;

function getsubj(str:string):string;
label 1;
var
i,i1,i2:integer;
name:string;
begin
name:='';
for i:=1 to 100 do begin
if str[i]=':' then i1:=i+1;
if str[i]=';' then begin i2:=i-1; goto 1;end;
end;
1:
for i:=i1 to i2 do begin
name:=name+str[i];
end;
getsubj:=name;
end;

function geterr(str:string):string;
label 1;
var
i,i1,i2:integer;
begin
for i:=1 to 100 do begin
if str[i]=':' then i1:=i+1;
if str[i]=';' then begin i2:=i; goto 1;end;
end;
1:
geterr:=str[i2+1];
end;


function getday(str:string;yyy:integer):string;
label 1,2;
var
day,day2,i:integer;
day1:string;
begin
day:=0;
day1:='';
for i:=1 to 100 do begin
if str[i]=';' then goto 1;
day1:=day1+str[i];

end;
1: if (yyy=2) then begin getday:=day1;goto 2;end;
val(day1,day2,i);
if (yyy=1) then begin
if i=0 then day:=day2 else day:=0;
if (day>0) and (day<7) then begin
if day=1 then
getday:='понедельник';
if day=2 then
getday:='вторник ';
if day=3 then
getday:='среда ';
if day=4 then
getday:='четверг ';
if day=5 then
getday:='пятница ';
if day=6 then
getday:='суббота ';
end else getday:='!Ошибка! ';
end;
2:
end;

function getstarttime(str:string):string;
label 1;
var
i,i1,i2,i3:integer;
time:string;
begin
i3:=0;
time:='';
for i:=1 to 100 do begin
if (str[i]=';') and (i3=1) then begin i2:=i-1; goto 1;end;
if (str[i]=';') and (i3=0) then begin i3:=1; i1:=i+1; end;
end;
1:
for i:=i1 to i2 do begin
time:=time+str[i];
end;
if length(time)>5 then getstarttime:='Ошибка!' else
getstarttime:=time;
end;

function getfinishtime(str:string):string;
label 1;
var
i,i1,i2,i3:integer;
time:string;
begin
i3:=0;
time:='';
for i:=1 to 100 do begin
if (str[i]=';') and (i3=2) then begin i2:=i-1; goto 1;end;
if (str[i]=';') and (i3=1) then begin i3:=2; i1:=i+1; end;
if (str[i]=';') and (i3=0) then i3:=1;
end;
1:
for i:=i1 to i2 do begin
time:=time+str[i];
end;
if length(time)>5 then getfinishtime:='Ошибка!' else
getfinishtime:=time;
end;

function getnumber(str:string):integer;
label 1;
var
numb,i,i1,i2,i3:integer;
num:string;
begin
i3:=0;
num:='';
for i:=1 to 100 do begin
if (str[i]=';') and (i3=3) then begin i2:=i-1; goto 1;end;
if (str[i]=';') and (i3=2) then begin i3:=3; i1:=i+1; end;
if (str[i]=';') and (i3=1) then i3:=2;
if (str[i]=';') and (i3=0) then i3:=1;
end;
1:
for i:=i1 to i2 do begin
num:=num+str[i];
end;
val(num,numb,i3);
if i3=0 then getnumber:=numb else getnumber:=(-5);
end;

function getfirstweek(str:string):integer;
label 1;
var
numb,i,i1,i2,i3:integer;
num:string;
begin
i3:=0;
num:='';
for i:=1 to 100 do begin
if (str[i]=';') and (i3=4) then begin i2:=i-1; goto 1;end;
if (str[i]=';') and (i3=3) then begin i3:=4; i1:=i+1; end;
if (str[i]=';') and (i3=2) then i3:=3;
if (str[i]=';') and (i3=1) then i3:=2;
if (str[i]=';') and (i3=0) then i3:=1;
end;
1:
for i:=i1 to i2 do begin
num:=num+str[i];
end;
val(num,numb,i3);
if i3=0 then getfirstweek:=numb else getfirstweek:=(-5);
end;

function getlastweek(str:string):integer;
label 1;
var
numb,i,i1,i2,i3:integer;
num:string;
begin
i3:=0;
num:='';
for i:=1 to 100 do begin
if (str[i]=';') and (i3=5) then begin i2:=i-1; goto 1;end;
if (str[i]=';') and (i3=4) then begin i3:=5; i1:=i+1; end;
if (str[i]=';') and (i3=3) then i3:=4;
if (str[i]=';') and (i3=2) then i3:=3;
if (str[i]=';') and (i3=1) then i3:=2;
if (str[i]=';') and (i3=0) then i3:=1;
end;
1:
for i:=i1 to i2 do begin
num:=num+str[i];
end;
val(num,numb,i3);
if i3=0 then getlastweek:=numb else getlastweek:=(-5);
end;

function gettype(str:string):string;
label 1;
var
numb,i,i1,i2,i3:integer;
num:string;
begin
i3:=0;
num:='';
for i:=1 to 100 do begin
if (str[i]=';') and (i3=6) then begin i2:=i-1; goto 1;end;
if (str[i]=';') and (i3=5) then begin i3:=6; i1:=i+1; end;
if (str[i]=';') and (i3=4) then i3:=5;
if (str[i]=';') and (i3=3) then i3:=4;
if (str[i]=';') and (i3=2) then i3:=3;
if (str[i]=';') and (i3=1) then i3:=2;
if (str[i]=';') and (i3=0) then i3:=1;
end;
1:
for i:=i1 to i2 do begin
num:=num+str[i];
end;
if (num='практика') or (num='лекция') then begin
if num='практика' then
gettype:='практика';
if num='лекция' then
gettype:='лекция ';
end else
gettype:='!Ошибка!';
end;

function subjnum(nomer:integer):string;
label 1;
var
jj:integer;
begin
subjnum:='!Ошибка!';
for jj:=1 to sizef1 do begin
if getnum(n[jj])=nomer then begin subjnum:=getsubj(n[jj]);goto 1;end;
end;
1:
end;

function subjstr(nomer:integer):integer;
label 1;
var
jj:integer;
begin
for jj:=1 to sizef1 do begin
if getnum(n[jj])=nomer then begin subjstr:=jj;goto 1;end;
end;
1:
end;


function writestr(jk:integer):string;
label propusk;
begin
if geterr(n[subjstr(getnumber(h[jk]))])='!' then goto propusk;
if length(getstarttime(h[jk]))<5 then write(namef13,'| ',getstarttime(h[jk]),' |') else
write(namef13,'| ',getstarttime(h[jk]),' |');
if length(getfinishtime(h[jk]))<5 then write(namef13,getfinishtime(h[jk]),' | ') else
write(namef13,getfinishtime(h[jk]),' | ');
write(namef13,getday(h[jk],1),' | ',subjnum(getnumber(h[jk])));
for j5:=length(subjnum(getnumber(h[jk])))+1 to maxlen4 do write(namef13,' ');
write(namef13,' | ',gettype(h[jk]));
if getfirstweek(h[jk])<10 then
write(namef13,' | ',getfirstweek(h[jk]),' ') else write(namef13,' | ',getfirstweek(h[jk]),' ');
if getlastweek(h[jk])<10 then
writeln(namef13,'| ',getlastweek(h[jk]),' | ') else writeln(namef13,'| ',getlastweek(h[jk]),' |');
propusk:
end;

function timeint(time:string):integer;
label 1,ab;
var
time1:string;
i,o:integer;
begin
time1:='';
if time='Ошибка!' then begin timeint:=12345;goto ab;end;
for i:=1 to length(time) do begin
if time[i]=':' then goto 1;
time1:=time1+time[i];
1:end;
val(time1,o,i);
if i=0 then timeint:=o else timeint:=12345;
ab:
end;

function chkformistakes:integer;
label prop;
var
jc,jk,i3,i,r,t,b:integer;
err,err1:boolean;
errlg:text;
ferr,ferr1:boolean;
ll:string;
begin
err:=false;
ferr:=false;
err1:=false;
ferr1:=false;
assign(errlg,'errorlog.txt');
rewrite(errlg);
writeln(errlg,'Ошибки в файле F2:');
for jc:=1 to sizef2 do begin
if getday(h[jc],1)='!Ошибка! ' then begin err:=true;writeln(errlg,'Ошибка в ',jc,' строке, неверно указан день недели. Номер дня: ',getday(h[jc],2));end;
if not ((getstarttime(h[jc])='8:00') or (getstarttime(h[jc])='9:45') or (getstarttime(h[jc])='12:10') or (getstarttime(h[jc])='13:55') or (getstarttime(h[jc])='16:10') or (getstarttime(h[jc])='17:55'))
then begin err:=true;writeln(errlg,'Ошибка в ',jc,' строке, время начала ',getstarttime(h[jc]),' не совпадает с расписанием');end;
if not ((getfinishtime(h[jc])='9:35') or (getfinishtime(h[jc])='11:20') or (getfinishtime(h[jc])='13:45') or (getfinishtime(h[jc])='15:30') or (getfinishtime(h[jc])='17:45') or (getfinishtime(h[jc])='19:30'))
then begin err:=true;writeln(errlg,'Ошибка в ',jc,' строке, время окончания ',getfinishtime(h[jc]),' не совпадает с расписанием');end;
if timeint(getstarttime(h[jc]))>timeint(getfinishtime(h[jc])) then begin err:=true;writeln(errlg,'Ошибка в ',jc,' строке, время окончания ',getfinishtime(h[jc]),' предшествует времени начала ',getstarttime(h[jc]));end;
if subjnum(getnumber(h[jc]))='!Ошибка!' then begin err:=true;writeln(errlg,'Ошибка в ',jc,' строке, не найден предмет с номером ',getnumber(h[jc]));end;
if (getfirstweek(h[jc])<1) or (getfirstweek(h[jc])>24) then begin err:=true;writeln(errlg,'Ошибка в ',jc,' строке, ошибка ввода первой недели. Введена ',getfirstweek(h[jc]),' неделя');end;
if (getlastweek(h[jc])<1) or (getlastweek(h[jc])>24) then begin err:=true;writeln(errlg,'Ошибка в ',jc,' строке, ошибка ввода последней недели Введена ',getlastweek(h[jc]),' неделя');end;
if (getlastweek(h[jc])<getfirstweek(h[jc])) then begin err:=true;writeln(errlg,'Ошибка в ',jc,' строке, последняя неделя (№ ',getlastweek(h[jc]),') начинается раньше первой (№ ',getfirstweek(h[jc]),')');end;
if gettype(h[jc])='!Ошибка!' then begin err:=true;writeln(errlg,'Ошибка в ',jc,' строке, тип занятий указан неверно. День недели: ',getday(h[jc],1),' Время начала:',getstarttime(h[jc]),' Предмет: ',subjnum(getnumber(h[jc])));end;


for jk:=1 to sizef2 do begin
if jk<=jc then goto prop;
if getday(h[jc],2)=getday(h[jk],2) then begin
if timeint(getstarttime(h[jc]))<=timeint(getfinishtime(h[jk]))then begin
if timeint(getfinishtime(h[jk]))<=timeint(getfinishtime(h[jc])) then begin
if getfirstweek(h[jk])<=getlastweek(h[jc]) then begin
if getlastweek(h[jk])>=getfirstweek(h[jc]) then begin err:=true;writeln(errlg,'Ошибка в ',jc,' и ',jk,' строках, совпадают занятия: ',subjnum(getnumber(h[jc])),' (',getstarttime(h[jc]),'-',getfinishtime(h[jc]),') и ',subjnum(getnumber(h[jk])),' (',getstarttime(h[jk]),'-',getfinishtime(h[jk]),')');end;
end;end;end;
if timeint(getstarttime(h[jc]))<=timeint(getstarttime(h[jk])) then begin
if timeint(getstarttime(h[jk]))<=timeint(getfinishtime(h[jc])) then begin
if getfirstweek(h[jk])<=getlastweek(h[jc]) then begin
if getlastweek(h[jk])>=getfirstweek(h[jc]) then begin err:=true;writeln(errlg,'Ошибка в ',jc,' и ',jk,' строках, совпадают занятия: ',subjnum(getnumber(h[jc])),' (',getstarttime(h[jc]),'-',getfinishtime(h[jc]),') и ',subjnum(getnumber(h[jk])),' (',getstarttime(h[jk]),'-',getfinishtime(h[jk]),')');end;
end;end;end;
end;
prop:
end;



if length(h[jc])>100 then begin ferr:=true;writeln(errlg,'Критическая ошибка! в ',jc,' строке, превышена допустимая длина строки. Длина:',length(h[jc]));end else begin
if ((timeint(getstarttime(h[jc]))<0) or (timeint(getstarttime(h[jc]))>2359)) then begin err:=true;writeln(errlg,'Ошибка в ',jc,' строке, неверно указано время начала, данные из строки не будут отображены в F3, день недели: ',getday(h[jc],1),' предмет № ',getnumber(h[jc]));end;
for r:=1 to 24 do begin
if (timeint(getstarttime(h[jc]))-r*100)>0 then
if (timeint(getstarttime(h[jc]))-r*100)<100 then
if (timeint(getstarttime(h[jc]))-r*100)>59 then begin err:=true;writeln(errlg,'Ошибка в ',jc,' строке, неверно указано время начала, данные из строки не будут отображены в F3, день недели: ',getday(h[jc],1),' предмет № ',getnumber(h[jc]));end;





if (timeint(getfinishtime(h[jc]))-r*100)>0 then begin
if (timeint(getfinishtime(h[jc]))-r*100)<100 then begin
if (timeint(getfinishtime(h[jc]))-r*100)>59 then begin err:=true;writeln(errlg,'Ошибка в ',jc,' строке, неверно указано время окончания, день недели: ',getday(h[jc],1),' предмет № ',getnumber(h[jc]),' Время начала:',getstarttime(h[jc]));end;
end;
end;
end;
i3:=0;
for i:=1 to 100 do begin
if (h[jc][i]=';') and (i3=6) then i3:=7;
if (h[jc][i]=';') and (i3=5) then i3:=6;
if (h[jc][i]=';') and (i3=4) then i3:=5;
if (h[jc][i]=';') and (i3=3) then i3:=4;
if (h[jc][i]=';') and (i3=2) then i3:=3;
if (h[jc][i]=';') and (i3=1) then i3:=2;
if (h[jc][i]=';') and (i3=0) then i3:=1;
end;
if i3<>7 then begin ferr:=true;writeln(errlg,'Критическая ошибка! в ',jc,' строке, нарушена структура данных. Количество ";" равно ', i3);end;
end;
end;

writeln(errlg,'Ошибки в файле F1:');
for t:=1 to sizef1 do begin

i3:=0;
for i:=1 to 100 do begin
if (n[t][i]=':') and (i3=0) then i3:=1;
if (n[t][i]=';') and (i3=1) then i3:=2;
end;
if i3<>2 then begin err1:=true;write(errlg,'Ошибка в ',t,' строке, нарушена структура данных');if i3=0 then writeln(errlg,' Не найдено ":"'); if i3=1 then writeln(errlg,' Не найдено ";"') end;

for b:=1 to sizef1 do begin
if b>t then begin
if getnum(n[b])=getnum(n[t]) then begin err1:=true;writeln(errlg,'Ошибка в ',b,' и ',t,' строках совпадают номера предметов, предметы:',getsubj(n[b]),' и ',getsubj(n[t]));n[b]:=n[b]+'!';n[t]:=n[t]+'!';end;
if getsubj(n[b])=getsubj(n[t]) then begin err1:=true;writeln(errlg,'Ошибка в ',b,' и ',t,' строках совпадают названия предметов, предметы:',getnum(n[b]),' и ',getnum(n[t]));n[b]:=n[b]+'!';n[t]:=n[t]+'!';end;
end;
end;

end;

close(errlg);
if ((err=false) and (ferr=false) and (err1=false)) then begin chkformistakes:=0; erase(errlg);end;
if err=true then chkformistakes:=1;
if ferr=true then chkformistakes:=2;
if ((err=true) and (err1=true)) then chkformistakes:=3;
if err1=true then chkformistakes:=4;
end;


BEGIN
erroropen:=FALSE;
pov1:gotoxy(1,1);writeln('” ©« 1:');readln(namef1);if namef1='' then goto pov1;
pov2:gotoxy(1,3);writeln('” ©« 2:');readln(namef2);if namef2='' then goto pov2;
pov3:gotoxy(1,5);writeln('” ©« 3:');readln(namef3);if namef3='' then goto pov3;
assign(namef11,namef1);
assign(namef12,namef2);
assign(namef13,namef3);
{$I-}
reset(namef11);
{$I+}
if ioresult<>0 then begin erroropen:=TRUE; writeln('ЋиЁЎЄ !” ©«  F1 ­Ґ бгйҐбвўгҐв');readkey;goto op1;end;
close(namef11);
op1:
{$I-}
reset(namef12);
{$I+}
if ioresult<>0 then begin erroropen:=TRUE; writeln('ЋиЁЎЄ !” ©«  F2 ­Ґ бгйҐбвўгҐв');readkey;goto op2;end;
close(namef12);
op2:
{$I-}
rewrite(namef13);
{$I+}
if ioresult<>0 then begin erroropen:=TRUE; writeln('ЋиЁЎЄ !ЌҐў®§¬®¦­® ᮧ¤ вм д ©« F3');readkey;goto op3;end;
close(namef13);
op3:
if erroropen=TRUE then begin writeln('Џа®¤®«¦Ґ­ЁҐ а Ў®вл ­Ґў®§¬®¦­®');readkey;exit;end;

//---------------------------------------------------------
reset(namef12);
j:=1;
while not EOF(namef12) do begin
readln(namef12,h[j]);
j:=j+1;
end;
sizef2:=j-1;
close(namef12);
//---------------------------------------------------------
reset(namef11);
j:=1;
while not EOF(namef11) do begin
readln(namef11,n[j]);
j:=j+1;
end;
close(namef11);
sizef1:=j-1;

maxlen4:=0;
for j:=1 to sizef1 do begin
if maxlen4<length(getsubj(n[j])) then maxlen4:=length(getsubj(n[j]));
end;

//---------------------------------------------------------
j3:=0;
j3:=chkformistakes;
if j3=1 then begin writeln('‚ 室Ґ а Ў®вл ­ ©¤Ґ­л ®иЁЎЄЁ ў д ©«Ґ F2. ‚®§¬®¦­® ­ҐЄ®а४⭮Ґ ®в®Ўа ¦Ґ­ЁҐ ¤ ­­ле ў д ©«Ґ F3.');
writeln('Џ®«­л© бЇЁб®Є ®иЁЎ®Є ­ е®¤Ёвбп ў д ©«Ґ errorlog.txt');
writeln('Ќ ¦¬ЁвҐ «оЎго Є« ўЁиг');readkey;end;
if j3=2 then begin writeln('‚ 室Ґ а Ў®вл ­ ©¤Ґ­л ®иЁЎЄЁ ў д ©«Ґ F2. ‚®§¬®¦­® ­ҐЄ®а४⭮Ґ ®в®Ўа ¦Ґ­ЁҐ ¤ ­­ле ў д ©«Ґ F3.');
writeln('Џ®«­л© бЇЁб®Є ®иЁЎ®Є ­ е®¤Ёвбп ў д ©«Ґ errorlog.txt');
writeln('Ќ ¦¬ЁвҐ «оЎго Є« ўЁиг');readkey;
//halt;
end;
if j3=3 then begin writeln('‚ 室Ґ а Ў®вл ­ ©¤Ґ­л ®иЁЎЄЁ ў д ©« е F1 Ё F2. ‚®§¬®¦­® ­ҐЄ®а४⭮Ґ ®в®Ўа ¦Ґ­ЁҐ ¤ ­­ле ў д ©«Ґ F3.');
writeln('Џ®«­л© бЇЁб®Є ®иЁЎ®Є ­ е®¤Ёвбп ў д ©«Ґ errorlog.txt');
writeln('Ќ ¦¬ЁвҐ «оЎго Є« ўЁиг');readkey;end;
if j3=4 then begin writeln('‚ 室Ґ а Ў®вл ­ ©¤Ґ­л ®иЁЎЄЁ ў д ©«Ґ F1 . ‚®§¬®¦­® ­ҐЄ®а४⭮Ґ ®в®Ўа ¦Ґ­ЁҐ ¤ ­­ле ў д ©«Ґ F3.');
writeln('Џ®«­л© бЇЁб®Є ®иЁЎ®Є ­ е®¤Ёвбп ў д ©«Ґ errorlog.txt');
writeln('Ќ ¦¬ЁвҐ «оЎго Є« ўЁиг');readkey;end;


writing:
rewrite(namef13);
write(namef13,'+--------+-----------+-------------+-');for j:=0 to maxlen4 do write(namef13,'-'); writeln(namef13,'-+----------+----------+----------+');
write(namef13,'| Время | Время | День недели | Название предмета ');for j:=18 to maxlen4 do write(namef13,' ');writeln(namef13,' | Вид | С какой | По какую |');
write(namef13,'| начала | окончания | | ');for j:=18 to maxlen4 do write(namef13,' ');writeln(namef13,' | занятий | недели | неделю |');
write(namef13,'+--------+-----------+-------------+-');for j:=0 to maxlen4 do write(namef13,'-'); writeln(namef13,'-+----------+----------+----------+');
m1:=0;sch:=0;
sort:
m2:=2400;
for j:=1 to sizef2 do begin
if m2>timeint(getstarttime(h[j])) then begin
if m1<timeint(getstarttime(h[j])) then
m2:=timeint(getstarttime(h[j])); end;
end;
for j:=1 to sizef2 do begin
if timeint(getstarttime(h[j]))=m2 then
writestr(j);end;
m1:=m2;sch:=sch+1;
if sch=sizef2 then goto fin else goto sort;

fin:
write(namef13,'+--------+-----------+-------------+-');for j:=0 to maxlen4 do write(namef13,'-');writeln(namef13,'-+----------+----------+----------+');
close(namef13);
END.
Соседние файлы в папке Курсовой проект2