From 04e68443040c7abad84d66477e98f93bed701760 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 4 Feb 2019 13:09:03 +0100 Subject: Initial import --- app/schulis/2.2.1/src/6.ida.check | 162 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 162 insertions(+) create mode 100644 app/schulis/2.2.1/src/6.ida.check (limited to 'app/schulis/2.2.1/src/6.ida.check') diff --git a/app/schulis/2.2.1/src/6.ida.check b/app/schulis/2.2.1/src/6.ida.check new file mode 100644 index 0000000..34d7616 --- /dev/null +++ b/app/schulis/2.2.1/src/6.ida.check @@ -0,0 +1,162 @@ +PACKET ispidacheckDEFINES fehlerinformular,formfehlermelden, +fehlerindruckvariable,ausdruckwardruckvariable:LET okkenner="k",kennnormal= +"+",kennauffaellig="#",linkeklammer="<",rechteklammer=">";FILE VAR formtext; +TEXT VAR zeile:="",blockstruktur:="",zugriffsreihenfolge:="";INT VAR errormld +:=0,errorline:=0;BOOL VAR fehlerfrei;LET mldplatzhalter=230,mldschachtelung= +231,mldtextkosmetik=232,mldnichtverfuegbar=233,mldregelunbekannt=234, +mldvarunbekannt=235,mldfeldunbekannt=236,mlddateiunbekannt=237, +mldmussleitobjekt=238,laengeblockkey=6,kzkosmetik="#";LET mldkeinevar=239, +mldvarfehler=240,mldkeinbegrenzer=241,mldtypkonflikt=242,mldkeinezeichenkette +=243,mldrestunbekannt=244,mldklammerfehlt=245;LET parametergrenze="%", +parametertrennzeichen="#",otherwise="*",textbegrenzer="""";BOOL VAR +wardruckvar:=TRUE ;PROC fehlersetzen(INT CONST nr):errormld:=nr;errorline:= +max(lineno(formtext)-1,1);fehlerfrei:=FALSE ;ENDPROC fehlersetzen;PROC +formfehlermelden:TEXT VAR zusatz:=" in Zeile ";IF errormld>0THEN zusatzCAT +text(errorline);standardmeldung(errormld,zusatz+kennnormal+" "+ +kennauffaellig);pause;FI ;errormld:=0ENDPROC formfehlermelden;PROC +zugriffmerken(INT CONST objklasse):INT CONST dnr:=dateinr(getobjektklasse( +objklasse));IF dnr=0THEN fehlersetzen(mlddateiunbekannt)ELSE +zugriffsreihenfolgeCAT "!"+text(dnr)+"!"FI ENDPROC zugriffmerken;BOOL PROC +dateischonimzugriff(INT CONST datei):pos(zugriffsreihenfolge,"!"+text(datei)+ +"!")>0ENDPROC dateischonimzugriff;TEXT PROC blockkey(INT CONST objklasse, +regel):"!"+text(objklasse,2)+text(regel,2)+"!"ENDPROC blockkey;BOOL PROC +blockschliessen(INT CONST objklasse,regel):INT CONST p:=pos(blockstruktur, +blockkey(objklasse,regel));IF p>0CAND fehlerfreiTHEN +pruefeobregelmehrfachauftritt;IF fehlerfreiTHEN pruefeobrichtiggeklammertFI +FI ;p>0.pruefeobregelmehrfachauftritt:IF pos(subtext(blockstruktur,p+ +laengeblockkey),blockkey(objklasse,regel))>0THEN fehlersetzen(mldschachtelung +)FI .pruefeobrichtiggeklammert:TEXT VAR bs:=subtext(blockstruktur,p+ +laengeblockkey),kr:="";INT VAR pp;WHILE length(bs)>1REP kr:=text(bs, +laengeblockkey);bs:=subtext(bs,laengeblockkey+1);pp:=pos(bs,kr);IF pp=0THEN +fehlersetzen(mldschachtelung);LEAVE pruefeobrichtiggeklammertELSE change(bs, +pp,pp+laengeblockkey-1,"")FI PER .ENDPROC blockschliessen;PROC +pruefeaufdisjunkteobjektklassen(INT CONST objkl):TEXT VAR bs:=blockstruktur, +kr:="";TEXT CONST objklkey:="!"+text(objkl,2);INT VAR p:=pos(bs,objklkey); +WHILE p>0REP kr:=subtext(bs,p,p+laengeblockkey-1);change(bs,p,p+ +laengeblockkey-1,"");p:=pos(bs,kr);IF p=0THEN fehlersetzen(mldschachtelung); +LEAVE pruefeaufdisjunkteobjektklassenELSE change(bs,p,p+laengeblockkey-1,""); +p:=pos(bs,objklkey)FI PER ENDPROC pruefeaufdisjunkteobjektklassen;PROC +pruefeobverbundfelderverfuegbar(INT CONST regelnummer):INT VAR i,fnr,datei; +TEXT VAR vglwert:="";FOR iFROM 1UPTO getanzahlregelfelder(regelnummer)REP +vglwert:=getvergleichswert(regelnummer,i);IF feldnameTHEN fnr:=feldnr(vglwert +);IF fnr=0THEN fehlersetzen(mldfeldunbekannt);LEAVE +pruefeobverbundfelderverfuegbarFI ;datei:=dateinrzufeld(fnr);IF NOT +dateischonimzugriff(datei)THEN fehlersetzen(mldnichtverfuegbar);LEAVE +pruefeobverbundfelderverfuegbarFI FI PER .feldname:(vglwertSUB 1)<>"""". +ENDPROC pruefeobverbundfelderverfuegbar;PROC pruefeobdatenbereitsverfuegbar( +TEXT CONST ausdruck):LET parametergrenze="%";TEXT VAR evtlfeldname:=ausdruck; +INT VAR fnr,dnr;IF pos(evtlfeldname,parametergrenze)>0THEN evtlfeldname:=text +(evtlfeldname,pos(evtlfeldname,parametergrenze)-1);FI ;fnr:=feldnr( +evtlfeldname);IF fnr>0THEN dnr:=dateinrzufeld(fnr);IF NOT dateischonimzugriff +(dnr)THEN fehlersetzen(mldnichtverfuegbar);FI FI ENDPROC +pruefeobdatenbereitsverfuegbar;PROC blockkeymerken(INT CONST objklasse,regel) +:IF blockstruktur=""CAND objklasse<>1CAND fehlerfreiTHEN fehlersetzen( +mldmussleitobjekt)ELSE blockstrukturCAT blockkey(objklasse,regel);FI ENDPROC +blockkeymerken;BOOL PROC textkommando(TEXT CONST ausdruck):TEXT VAR parameter +:="";IF pos("!page!head!bottom!end!","!"+ausdruck+"!")>0THEN LEAVE +textkommandoWITH TRUE FI ;IF pos(ausdruck,"on")=1THEN parameter:=compress( +subtext(ausdruck,3));pruefeparameterELIF pos(ausdruck,"off")=1THEN parameter +:=compress(subtext(ausdruck,4));pruefeparameterELSE FALSE FI .pruefeparameter +:IF text(parameter,2)<>"("""COR subtext(parameter,length(parameter)-1)<>""")" +THEN LEAVE pruefeparameterWITH FALSE FI ;parameter:=subtext(parameter,3, +length(parameter)-2);pos("!bold!b!underline!u!","!"+parameter+"!")>0.ENDPROC +textkommando;PROC zeileueberpruefen(TEXT CONST zeile):TEXT VAR textzeile:= +zeile,ausdruck:="";INT VAR vonp,bisp,stcodenr,ausglaenge;BOOL VAR rbuendig, +druckvar;IF fehlerfreiTHEN druckvariablenpruefen;textkosmetikpruefenFI . +druckvariablenpruefen:vonp:=pos(textzeile,linkeklammer);WHILE vonp>0REP bisp +:=pos(textzeile,rechteklammer,vonp+1);IF bisp=0THEN fehlersetzen( +mldplatzhalter);LEAVE zeileueberpruefenFI ;disablestop;stcodenr:=int(subtext( +textzeile,vonp+1,bisp-1));clearerror;enablestop;getsteuercode(stcodenr, +ausdruck,ausglaenge,rbuendig,druckvar);IF ausdruck=""COR NOT lastconversionok +THEN fehlersetzen(mldvarunbekannt);LEAVE zeileueberpruefenELSE +pruefeobdatenbereitsverfuegbar(ausdruck);FI ;change(textzeile,vonp,bisp,""); +vonp:=pos(textzeile,linkeklammer);PER .textkosmetikpruefen:textzeile:=zeile; +vonp:=pos(textzeile,kzkosmetik);WHILE vonp>0REP bisp:=pos(textzeile, +kzkosmetik,vonp+1);IF bisp=0THEN fehlersetzen(mldtextkosmetik);LEAVE +zeileueberpruefenFI ;ausdruck:=compress(subtext(textzeile,vonp+1,bisp-1));IF +NOT textkommando(ausdruck)THEN fehlersetzen(mldtextkosmetik);LEAVE +zeileueberpruefenFI ;change(textzeile,vonp,bisp,"");vonp:=pos(textzeile, +kzkosmetik);PER .ENDPROC zeileueberpruefen;PROC bearbeiteblock:INT VAR p,bis, +objklasse,regel;BOOL VAR eoformtext:=FALSE ;WHILE NOT eoformtextCAND +fehlerfreiREP IF zugriffsregelgefundenTHEN okundregelbestimmen;IF +blockschliessen(objklasse,regel)THEN blockkeymerken(objklasse,regel);LEAVE +bearbeiteblockELSE pruefeaufdisjunkteobjektklassen(objklasse);IF NOT +fehlerfreiTHEN LEAVE bearbeiteblockFI ;IF objklasse>1CAND fehlerfreiTHEN +pruefeobverbundfelderverfuegbar(getregelnummer(objklasse,regel));FI ; +blockkeymerken(objklasse,regel);zugriffmerken(objklasse);IF NOT fehlerfrei +THEN LEAVE bearbeiteblockFI ;IF compress(zeile)=""CAND NOT eoformtextTHEN +getline(formtext,zeile);FI ;bearbeiteblockFI ;ELSE zeileueberpruefen(zeile) +FI ;IF eof(formtext)THEN eoformtext:=TRUE ELSE getline(formtext,zeile);FI ; +PER ;.zugriffsregelgefunden:p:=pos(zeile,linkeklammer+okkenner);p>0. +okundregelbestimmen:bis:=p+2;objklasse:=int(zeileSUB bis);bisINCR 1;IF +istziffer(zeileSUB bis)THEN objklasse:=objklasse*10+int(zeileSUB bis);bis +INCR 1;FI ;IF objklasse<1COR objklasse>10THEN fehlersetzen(mldplatzhalter); +LEAVE bearbeiteblockFI ;IF (zeileSUB bis)=rechteklammerTHEN regel:=1ELSE +regel:=int(zeileSUB bis+1);bisINCR 2;IF istziffer(zeileSUB bis)THEN regel:= +regel*10+int(zeileSUB bis);bisINCR 1;FI ;FI ;change(zeile,p,bis,"");IF +objklasse>1CAND getregelnummer(objklasse,regel)=0THEN fehlersetzen( +mldregelunbekannt);LEAVE bearbeiteblockFI ;.ENDPROC bearbeiteblock;BOOL PROC +fehlerinformular:#openformular(nr);#fehlerfrei:=TRUE ;stopbeifalschemnamen( +FALSE );blockstruktur:="";zugriffsreihenfolge:="";zeile:="";errormld:=0; +errorline:=0;formtext:=sequentialfile(input,getformtextname);IF NOT eof( +formtext)THEN getline(formtext,zeile)FI ;IF eof(formtext)CAND zeile=""THEN +ELSE bearbeiteblockFI ;IF fehlerfreiCAND length(blockstruktur)<= +laengeblockkeyTHEN fehlersetzen(mldschachtelung)FI ;stopbeifalschemnamen( +TRUE );NOT fehlerfreiENDPROC fehlerinformular;BOOL PROC istziffer(TEXT CONST +t):pos("0123456789",t)>0END PROC istziffer;BOOL PROC istsonderfunktion(TEXT +CONST ausdruck):TEXT CONST liste:="#tagesdatum#tag#monat#jahr#zeit#tt#mm#jj#" +;pos(liste,"#"+ausdruck+"#")>0ENDPROC istsonderfunktion;BOOL PROC istdbfeld( +TEXT CONST feldname):feldnr(feldname)>0ENDPROC istdbfeld;BOOL PROC +falscherdenotertyp(TEXT CONST vglswert,INT CONST aktfeldtyp):BOOL VAR fehler +:=FALSE ;INT VAR i;REAL VAR r;disablestop;IF aktfeldtyp=intfeldTHEN i:=int( +vglswert);fehler:=NOT lastconversionokCOR iserrorELIF aktfeldtyp=realfeld +THEN r:=real(vglswert);fehler:=NOT lastconversionokCOR iserrorELIF aktfeldtyp +=datumfeldTHEN r:=date(vglswert);fehler:=iserrorFI ;clearerror;enablestop; +fehlerEND PROC falscherdenotertyp;BOOL PROC ausdruckwardruckvariable: +wardruckvarENDPROC ausdruckwardruckvariable;BOOL PROC fehlerindruckvariable( +TEXT CONST origausdruck):BOOL VAR fehlerhaft:=FALSE ;INT VAR p;TEXT VAR +ausdruck:=compress(origausdruck),feldname:="";stopbeifalschemnamen(FALSE ); +wardruckvar:=TRUE ;liesfeldname;IF NOT istdbfeld(feldname)THEN IF +istsonderfunktion(feldname)THEN IF ausdruck=""THEN wardruckvar:=FALSE ELSE +standardmeldung(mldvarfehler,ausdruck);fehlerhaft:=TRUE ;FI ELSE +standardmeldung(mldkeinevar,feldname);fehlerhaft:=TRUE ;FI ;leaveprocFI ;IF +ausdruck>""THEN fehlerhaft:=zusammengesetzterausdruck(feldname,ausdruck)FI ; +stopbeifalschemnamen(TRUE );fehlerhaft.liesfeldname:p:=pos(ausdruck, +parametergrenze);IF p>0THEN feldname:=text(ausdruck,p-1);ausdruck:=subtext( +ausdruck,p+1)ELSE feldname:=ausdruck;ausdruck:=""FI .leaveproc: +stopbeifalschemnamen(TRUE );LEAVE fehlerindruckvariableWITH fehlerhaft. +ENDPROC fehlerindruckvariable;BOOL PROC zusammengesetzterausdruck(TEXT CONST +aktfeld,TEXT VAR ausdruck):TEXT VAR feldname:="",vglswert:="";INT CONST +aktfeldtyp:=feldtyp(feldnr(aktfeld));INT VAR p;BOOL VAR fehlerhaft:=FALSE ; +WHILE ausdruck>""CAND (ausdruckSUB 1)<>rechteklammerREP +pruefefallunterscheidung;PER ;fehlerhaft.pruefefallunterscheidung:p:=pos( +ausdruck,parametertrennzeichen);IF p=0THEN standardmeldung(mldkeinbegrenzer, +ausdruck);LEAVE zusammengesetzterausdruckWITH TRUE FI ;vglswert:=text( +ausdruck,p-1);ausdruck:=subtext(ausdruck,p+1);IF falscherdenotertyp(vglswert, +aktfeldtyp)THEN standardmeldung(mldtypkonflikt,vglswert);LEAVE +zusammengesetzterausdruckWITH TRUE FI ;pruefesequenz;IF (ausdruckSUB 1)= +otherwiseTHEN deletechar(ausdruck,1);pruefesequenzELIF (ausdruckSUB 1)= +parametertrennzeichenTHEN deletechar(ausdruck,1)ELIF ausdruck>""THEN IF ( +ausdruckSUB 1)=parametertrennzeichenTHEN ELIF (ausdruckSUB 1)=rechteklammer +THEN deletechar(ausdruck,1);LEAVE zusammengesetzterausdruckWITH fehlerhaft +ELSE standardmeldung(mldrestunbekannt,ausdruck);LEAVE +zusammengesetzterausdruckWITH TRUE FI FI .pruefesequenz: +zeichenketteueberlesen;IF (ausdruckSUB 1)=linkeklammerTHEN deletechar( +ausdruck,1);IF postext(ausdruck,rechteklammer,1)=0THEN standardmeldung( +mldklammerfehlt,ausdruck);LEAVE zusammengesetzterausdruckWITH TRUE FI ; +liesfeldname;IF (ausdruckSUB 1)=parametergrenzeTHEN deletechar(ausdruck,1); +fehlerhaft:=zusammengesetzterausdruck(feldname,ausdruck);IF fehlerhaftTHEN +LEAVE zusammengesetzterausdruckWITH TRUE FI ;ELSE deletechar(ausdruck,1);FI +FI .liesfeldname:p:=1;WHILE (ausdruckSUB p)<>rechteklammerCAND (ausdruckSUB p +)<>parametergrenzeREP pINCR 1PER ;feldname:=text(ausdruck,p-1);ausdruck:= +subtext(ausdruck,p);IF NOT istdbfeld(feldname)THEN standardmeldung( +mldfeldunbekannt,feldname);LEAVE zusammengesetzterausdruckWITH TRUE FI . +zeichenketteueberlesen:IF (ausdruckSUB 1)<>textbegrenzerTHEN standardmeldung( +mldkeinezeichenkette,ausdruck);LEAVE zusammengesetzterausdruckWITH TRUE FI ;p +:=2;WHILE (ausdruckSUB p)<>textbegrenzerREP pINCR 1;IF (ausdruckSUB p)= +textbegrenzerCAND (ausdruckSUB p+1)=textbegrenzerTHEN pINCR 2;FI ;UNTIL p> +length(ausdruck)PER ;IF p>length(ausdruck)THEN standardmeldung( +mldkeinezeichenkette,ausdruck);LEAVE zusammengesetzterausdruckWITH TRUE FI ; +ausdruck:=compress(subtext(ausdruck,p+1)).ENDPROC zusammengesetzterausdruck; +END PACKET ispidacheck + -- cgit v1.2.3